package Mojo::Headers;

use Mojo::Base -base;

use Mojo::Util qw(get_line monkey_patch);

has max_line_size => sub { $ENV{MOJO_MAX_LINE_SIZE} || 10240 };

# Common headers

my @HEADERS = (

  qw(Accept Accept-Charset Accept-Encoding Accept-Language Accept-Ranges),

  qw(Allow Authorization Cache-Control Connection Content-Disposition),

  qw(Content-Encoding Content-Length Content-Range Content-Type Cookie DNT),

  qw(Date ETag Expect Expires Host If-Modified-Since Last-Modified Link),

  qw(Location Origin Proxy-Authenticate Proxy-Authorization Range),

  qw(Sec-WebSocket-Accept Sec-WebSocket-Extensions Sec-WebSocket-Key),

  qw(Sec-WebSocket-Protocol Sec-WebSocket-Version Server Set-Cookie Status),

  qw(TE Trailer Transfer-Encoding Upgrade User-Agent Vary WWW-Authenticate)

);

for my $header (@HEADERS) {

  my $name = lc $header;

  $name =~ s/-/_/g;

  monkey_patch __PACKAGE__, $name, sub { scalar shift->header($header => @_) };

}

# Lowercase headers

my %NORMALCASE = map { lc($_) => $_ } @HEADERS;

sub add {

  my ($self, $name) = (shift, shift);

  # Make sure we have a normal case entry for name

  my $key = lc $name;

  $self->{normalcase}{$key} //= $name unless $NORMALCASE{$key};

  # Add lines

  push @{$self->{headers}{$key}}, map { ref $_ eq 'ARRAY' ? $_ : [$_] } @_;

  return $self;

}

sub append {

  my ($self, $name, $value) = @_;

  my $old = $self->header($name);

  return $self->header($name => defined $old ? "$old, $value" : $value);

}

sub clone {

  my $self = shift;

  return $self->new->from_hash($self->to_hash(1));

}

sub from_hash {

  my ($self, $hash) = @_;

  # Empty hash deletes all headers

  delete $self->{headers} if keys %{$hash} == 0;

  # Merge

  while (my ($header, $value) = each %$hash) {

    $self->add($header => ref $value eq 'ARRAY' ? @$value : $value);

  }

  return $self;

}

sub header {

  my ($self, $name) = (shift, shift);

  # Replace

  return $self->remove($name)->add($name, @_) if @_;

  # String

  return unless my $headers = $self->{headers}{lc $name};

  return join ', ', map { join ', ', @$_ } @$headers unless wantarray;

  # Array

  return @$headers;

}

sub is_finished { (shift->{state} // '') eq 'finished' }

sub is_limit_exceeded { !!shift->{limit} }

sub leftovers { delete shift->{buffer} }

sub names {

  my $self = shift;

  return [map { $NORMALCASE{$_} || $self->{normalcase}{$_} || $_ }

      keys %{$self->{headers}}];

}

sub parse {

  my $self = shift;

  $self->{state} = 'headers';

  $self->{buffer} .= shift // '';

  my $headers = $self->{cache} ||= [];

  my $max = $self->max_line_size;

  while (defined(my $line = get_line \$self->{buffer})) {

    # Check line size limit

    if (length $line > $max) {

      $self->{limit} = $self->{state} = 'finished';

      return $self;

    }

    # New header

    if ($line =~ /^(\S+)\s*:\s*(.*)$/) { push @$headers, $1, [$2] }

    # Multiline

    elsif (@$headers && $line =~ s/^\s+//) { push @{$headers->[-1]}, $line }

    # Empty line

    else {

      $self->add(splice @$headers, 0, 2) while @$headers;

      $self->{state} = 'finished';

      return $self;

    }

  }

  # Check line size limit

  $self->{limit} = $self->{state} = 'finished'

    if length $self->{buffer} > $max;

  return $self;

}

sub referrer { scalar shift->header(Referer => @_) }

sub remove {

  my ($self, $name) = @_;

  delete $self->{headers}{lc $name};

  return $self;

}

sub to_hash {

  my ($self, $multi) = @_;

  my %hash;

  $hash{$_} = $multi ? [$self->header($_)] : scalar $self->header($_)

    for @{$self->names};

  return \%hash;

}

sub to_string {

  my $self = shift;

  # Make sure multiline values are formatted correctly

  my @headers;

  for my $name (@{$self->names}) {

    push @headers, "$name: " . join("\x0d\x0a ", @$_) for $self->header($name);

  }

  return join "\x0d\x0a", @headers;

}

1;

=encoding utf8

=head1 NAME

Mojo::Headers - Headers

=head1 SYNOPSIS

  use Mojo::Headers;

  # Parse

  my $headers = Mojo::Headers->new;

  $headers->parse("Content-Length: 42\x0d\x0a");

  $headers->parse("Content-Type: text/html\x0d\x0a\x0d\x0a");

  say $headers->content_length;

  say $headers->content_type;

  # Build

  my $headers = Mojo::Headers->new;

  $headers->content_length(42);

  $headers->content_type('text/plain');

  say $headers->to_string;

=head1 DESCRIPTION

L<Mojo::Headers> is a container for HTTP headers as described in RFC 2616.

=head1 ATTRIBUTES

L<Mojo::Headers> implements the following attributes.

=head2 max_line_size

  my $size = $headers->max_line_size;

  $headers = $headers->max_line_size(1024);

Maximum header line size in bytes, defaults to the value of the

MOJO_MAX_LINE_SIZE environment variable or C<10240>.

=head1 METHODS

L<Mojo::Headers> inherits all methods from L<Mojo::Base> and implements the

following new ones.

=head2 accept

  my $accept = $headers->accept;

  $headers   = $headers->accept('application/json');

Shortcut for the C<Accept> header.

=head2 accept_charset

  my $charset = $headers->accept_charset;

  $headers    = $headers->accept_charset('UTF-8');

Shortcut for the C<Accept-Charset> header.

=head2 accept_encoding

  my $encoding = $headers->accept_encoding;

  $headers     = $headers->accept_encoding('gzip');

Shortcut for the C<Accept-Encoding> header.

=head2 accept_language

  my $language = $headers->accept_language;

  $headers     = $headers->accept_language('de, en');

Shortcut for the C<Accept-Language> header.

=head2 accept_ranges

  my $ranges = $headers->accept_ranges;

  $headers   = $headers->accept_ranges('bytes');

Shortcut for the C<Accept-Ranges> header.

=head2 add

  $headers = $headers->add(Foo => 'one value');

  $headers = $headers->add(Foo => 'first value', 'second value');

  $headers = $headers->add(Foo => ['first line', 'second line']);

Add one or more header values with one or more lines.

  # "Vary: Accept"

  # "Vary: Accept-Encoding"

  $headers->vary('Accept')->add(Vary => 'Accept-Encoding')->to_string;

=head2 allow

  my $allow = $headers->allow;

  $headers  = $headers->allow('GET, POST');

Shortcut for the C<Allow> header.

=head2 append

  $headers = $headers->append(Vary => 'Accept-Encoding');

Append value to header and flatten it if necessary.

  # "Vary: Accept"

  $headers->append(Vary => 'Accept')->to_string;

  # "Vary: Accept, Accept-Encoding"

  $headers->vary('Accept')->append(Vary => 'Accept-Encoding')->to_string;

=head2 authorization

  my $authorization = $headers->authorization;

  $headers          = $headers->authorization('Basic Zm9vOmJhcg==');

Shortcut for the C<Authorization> header.

=head2 cache_control

  my $cache_control = $headers->cache_control;

  $headers          = $headers->cache_control('max-age=1, no-cache');

Shortcut for the C<Cache-Control> header.

=head2 clone

  my $clone = $headers->clone;

Clone headers.

=head2 connection

  my $connection = $headers->connection;

  $headers       = $headers->connection('close');

Shortcut for the C<Connection> header.

=head2 content_disposition

  my $disposition = $headers->content_disposition;

  $headers        = $headers->content_disposition('foo');

Shortcut for the C<Content-Disposition> header.

=head2 content_encoding

  my $encoding = $headers->content_encoding;

  $headers     = $headers->content_encoding('gzip');

Shortcut for the C<Content-Encoding> header.

=head2 content_length

  my $len  = $headers->content_length;

  $headers = $headers->content_length(4000);

Shortcut for the C<Content-Length> header.

=head2 content_range

  my $range = $headers->content_range;

  $headers  = $headers->content_range('bytes 2-8/100');

Shortcut for the C<Content-Range> header.

=head2 content_type

  my $type = $headers->content_type;

  $headers = $headers->content_type('text/plain');

Shortcut for the C<Content-Type> header.

=head2 cookie

  my $cookie = $headers->cookie;

  $headers   = $headers->cookie('f=b');

Shortcut for the C<Cookie> header from RFC 6265.

=head2 date

  my $date = $headers->date;

  $headers = $headers->date('Sun, 17 Aug 2008 16:27:35 GMT');

Shortcut for the C<Date> header.

=head2 dnt

  my $dnt  = $headers->dnt;

  $headers = $headers->dnt(1);

Shortcut for the C<DNT> (Do Not Track) header, which has no specification yet,

but is very commonly used.

=head2 etag

  my $etag = $headers->etag;

  $headers = $headers->etag('abc321');

Shortcut for the C<ETag> header.

=head2 expect

  my $expect = $headers->expect;

  $headers   = $headers->expect('100-continue');

Shortcut for the C<Expect> header.

=head2 expires

  my $expires = $headers->expires;

  $headers    = $headers->expires('Thu, 01 Dec 1994 16:00:00 GMT');

Shortcut for the C<Expires> header.

=head2 from_hash

  $headers = $headers->from_hash({'Content-Type' => 'text/html'});

  $headers = $headers->from_hash({});

Parse headers from a hash reference, an empty hash removes all headers.

=head2 header

  my $value  = $headers->header('Foo');

  my @values = $headers->header('Foo');

  $headers   = $headers->header(Foo => 'one value');

  $headers   = $headers->header(Foo => 'first value', 'second value');

  $headers   = $headers->header(Foo => ['first line', 'second line']);

Get or replace the current header values.

  # Multiple headers with the same name

  for my $header ($headers->header('Set-Cookie')) {

    say 'Set-Cookie:';

    # Multiple lines per header

    say for @$header;

  }

=head2 host

  my $host = $headers->host;

  $headers = $headers->host('127.0.0.1');

Shortcut for the C<Host> header.

=head2 if_modified_since

  my $date = $headers->if_modified_since;

  $headers = $headers->if_modified_since('Sun, 17 Aug 2008 16:27:35 GMT');

Shortcut for the C<If-Modified-Since> header.

=head2 is_finished

  my $bool = $headers->is_finished;

Check if header parser is finished.

=head2 is_limit_exceeded

  my $bool = $headers->is_limit_exceeded;

Check if a header has exceeded C<max_line_size>.

=head2 last_modified

  my $date = $headers->last_modified;

  $headers = $headers->last_modified('Sun, 17 Aug 2008 16:27:35 GMT');

Shortcut for the C<Last-Modified> header.

=head2 leftovers

  my $bytes = $headers->leftovers;

Get leftover data from header parser.

=head2 link

  my $link = $headers->link;

  $headers = $headers->link('<http://127.0.0.1/foo/3>; rel="next"');

Shortcut for the C<Link> header from RFC 5988.

=head2 location

  my $location = $headers->location;

  $headers     = $headers->location('http://127.0.0.1/foo');

Shortcut for the C<Location> header.

=head2 names

  my $names = $headers->names;

Return a list of all currently defined headers.

  # Names of all headers

  say for @{$headers->names};

=head2 origin

  my $origin = $headers->origin;

  $headers   = $headers->origin('http://example.com');

Shortcut for the C<Origin> header from RFC 6454.

=head2 parse

  $headers = $headers->parse("Content-Type: text/plain\x0d\x0a\x0d\x0a");

Parse formatted headers.

=head2 proxy_authenticate

  my $authenticate = $headers->proxy_authenticate;

  $headers         = $headers->proxy_authenticate('Basic "realm"');

Shortcut for the C<Proxy-Authenticate> header.

=head2 proxy_authorization

  my $authorization = $headers->proxy_authorization;

  $headers          = $headers->proxy_authorization('Basic Zm9vOmJhcg==');

Shortcut for the C<Proxy-Authorization> header.

=head2 range

  my $range = $headers->range;

  $headers  = $headers->range('bytes=2-8');

Shortcut for the C<Range> header.

=head2 referrer

  my $referrer = $headers->referrer;

  $headers     = $headers->referrer('http://example.com');

Shortcut for the C<Referer> header, there was a typo in RFC 2068 which

resulted in C<Referer> becoming an official header.

=head2 remove

  $headers = $headers->remove('Foo');

Remove a header.

=head2 sec_websocket_accept

  my $accept = $headers->sec_websocket_accept;

  $headers   = $headers->sec_websocket_accept('s3pPLMBiTxaQ9kYGzzhZRbK+xOo=');

Shortcut for the C<Sec-WebSocket-Accept> header from RFC 6455.

=head2 sec_websocket_extensions

  my $extensions = $headers->sec_websocket_extensions;

  $headers       = $headers->sec_websocket_extensions('foo');

Shortcut for the C<Sec-WebSocket-Extensions> header from RFC 6455.

=head2 sec_websocket_key

  my $key  = $headers->sec_websocket_key;

  $headers = $headers->sec_websocket_key('dGhlIHNhbXBsZSBub25jZQ==');

Shortcut for the C<Sec-WebSocket-Key> header from RFC 6455.

=head2 sec_websocket_protocol

  my $proto = $headers->sec_websocket_protocol;

  $headers  = $headers->sec_websocket_protocol('sample');

Shortcut for the C<Sec-WebSocket-Protocol> header from RFC 6455.

=head2 sec_websocket_version

  my $version = $headers->sec_websocket_version;

  $headers    = $headers->sec_websocket_version(13);

Shortcut for the C<Sec-WebSocket-Version> header from RFC 6455.

=head2 server

  my $server = $headers->server;

  $headers   = $headers->server('Mojo');

Shortcut for the C<Server> header.

=head2 set_cookie

  my $cookie = $headers->set_cookie;

  $headers   = $headers->set_cookie('f=b; path=/');

Shortcut for the C<Set-Cookie> header from RFC 6265.

=head2 status

  my $status = $headers->status;

  $headers   = $headers->status('200 OK');

Shortcut for the C<Status> header from RFC 3875.

=head2 te

  my $te   = $headers->te;

  $headers = $headers->te('chunked');

Shortcut for the C<TE> header.

=head2 to_hash

  my $single = $headers->to_hash;

  my $multi  = $headers->to_hash(1);

Turn headers into hash reference, nested array references to represent

multiline values are disabled by default.

  say $headers->to_hash->{DNT};

=head2 to_string

  my $str = $headers->to_string;

Turn headers into a string, suitable for HTTP messages.

=head2 trailer

  my $trailer = $headers->trailer;

  $headers    = $headers->trailer('X-Foo');

Shortcut for the C<Trailer> header.

=head2 transfer_encoding

  my $encoding = $headers->transfer_encoding;

  $headers     = $headers->transfer_encoding('chunked');

Shortcut for the C<Transfer-Encoding> header.

=head2 upgrade

  my $upgrade = $headers->upgrade;

  $headers    = $headers->upgrade('websocket');

Shortcut for the C<Upgrade> header.

=head2 user_agent

  my $agent = $headers->user_agent;

  $headers  = $headers->user_agent('Mojo/1.0');

Shortcut for the C<User-Agent> header.

=head2 vary

  my $vary = $headers->vary;

  $headers = $headers->vary('*');

Shortcut for the C<Vary> header.

=head2 www_authenticate

  my $authenticate = $headers->www_authenticate;

  $headers         = $headers->www_authenticate('Basic realm="realm"');

Shortcut for the C<WWW-Authenticate> header.

=head1 SEE ALSO

L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.

=cut