APR-HTTP-Headers-Compat

 view release on metacpan or  search on metacpan

Build.PL  view on Meta::CPAN

use Module::Build;
use MyBuilder;

my $builder = MyBuilder->new(
  module_name          => 'APR::HTTP::Headers::Compat',
  license              => 'perl',
  dist_author          => 'Andy Armstrong <andy@hexten.net>',
  dist_version_from    => 'lib/APR/HTTP/Headers/Compat.pm',
  recursive_test_files => 1,
  requires             => {
    'APR::Pool'     => 0,
    'APR::Table'    => 0,
    'HTTP::Headers' => 0,
    'Storable'      => 0,
    'Test::More'    => 0,
  },
  add_to_cleanup => ['APR-HTTP-Headers-Compat-*'],
);

$builder->create_build_script();

META.yml  view on Meta::CPAN

---
name: APR-HTTP-Headers-Compat
version: 0.02
author:
  - 'Andy Armstrong <andy@hexten.net>'
abstract: Make an APR::Table look like an HTTP::Headers
license: perl
resources:
  bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=APR-HTTP-Headers-Compat
  license: http://dev.perl.org/licenses/
  repository: git://github.com/AndyA/APR--HTTP--Headers--Compat.git
requires:
  APR::Pool: 0
  APR::Table: 0
  HTTP::Headers: 0
  Storable: 0
  Test::More: 0
provides:
  APR::HTTP::Headers::Compat:
    file: lib/APR/HTTP/Headers/Compat.pm
    version: 0.02
  APR::HTTP::Headers::Compat::MagicArray:

inc/MyBuilder.pm  view on Meta::CPAN

  my ( $self, @args ) = @_;
  $self->_auto_mm;
  return $self->SUPER::create_build_script( @args );
}

sub _auto_mm {
  my $self = shift;
  my $mm   = $self->meta_merge;
  my @meta = qw( homepage bugtracker MailingList repository );
  for my $meta ( @meta ) {
    next if exists $mm->{resources}{$meta};
    my $auto = "_auto_$meta";
    next unless $self->can( $auto );
    my $av = $self->$auto();
    $mm->{resources}{$meta} = $av if defined $av;
  }
  $self->meta_merge( $mm );
}

sub _auto_repository {
  my $self = shift;
  if ( -d '.svn' ) {
    my $info = `svn info .`;
    return $1 if $info =~ /^URL:\s+(.+)$/m;
  }

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

table or the wrapper are reflected immediately in the other.

=cut

sub table { shift->_magic->table }

=head2 C<< remove_content_headers >>

This will remove all the header fields used to describe the content of a
message. All header field names prefixed with Content- falls into this
category, as well as Allow, Expires and Last-Modified. RFC 2616 denote
these fields as Entity Header Fields.

The return value is a new C<HTTP::Headers> object that contains the
removed headers only. Note that the returned object is I<not> an
C<APR::HTTP::Headers::Compat>.

=cut

sub remove_content_headers {
  my $self = shift;

t/compat/base/headers.t  view on Meta::CPAN

is( j( $h->clone->remove_header( "Not-There" ) ), "" );

$h = mk(
  allow            => "GET",
  content          => "none",
  content_type     => "text/html",
  content_md5      => "dummy",
  content_encoding => "gzip",
  content_foo      => "bar",
  last_modified    => "yesterday",
  expires          => "tomorrow",
  etag             => "abc",
  date             => "today",
  user_agent       => "libwww-perl",
  zoo              => "foo",
);
is( $h->as_string, <<EOT);
Date: today
User-Agent: libwww-perl
ETag: abc
Allow: GET
Content-Encoding: gzip
Content-MD5: dummy
Content-Type: text/html
Expires: tomorrow
Last-Modified: yesterday
Content: none
Content-Foo: bar
Zoo: foo
EOT

$h2 = $h->clone;
is( $h->as_string, $h2->as_string );

is( $h->remove_content_headers->as_string, <<EOT);
Allow: GET
Content-Encoding: gzip
Content-MD5: dummy
Content-Type: text/html
Expires: tomorrow
Last-Modified: yesterday
Content-Foo: bar
EOT

is( $h->as_string, <<EOT);
Date: today
User-Agent: libwww-perl
ETag: abc
Content: none
Zoo: foo

t/compat/base/headers.t  view on Meta::CPAN

  my $off = time - $h->date;
  ok( $off == 0 || $off == 1 );
}

if ( $] < 5.006 ) {
  Test::skip( "Can't call variable method", 1 ) for 1 .. 13;
}
else {
  # other date fields
  for my $field (
    qw(expires if_modified_since if_unmodified_since
    last_modified)
   ) {
    eval <<'EOT'; die $@ if $@;
    is($h->$field, undef);
    is($h->$field(time), undef);
    ok((time - $h->$field) =~ /^[01]$/);
EOT
  }
  is( j( $h->header_field_names ),
    "Date|If-Modified-Since|If-Unmodified-Since|Expires|Last-Modified"
  );
}

$h->clear;
is( $h->content_type,                         "" );
is( $h->content_type( "text/html" ),          "" );
is( $h->content_type,                         "text/html" );
is( $h->content_type( "   TEXT  / HTML   " ), "text/html" );
is( $h->content_type,                         "text/html" );
is( j( $h->content_type ),                    "text/html" );