File Coverage

blib/lib/Parse/WWWAuthenticate.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	9	10	90.0
condition	8	9	88.8
subroutine	7	7	100.0
pod	2	2	100.0
total	67	69	97.1

package Parse::WWWAuthenticate;

# ABSTRACT: Parse the WWW-Authenticate HTTP header

use strict;
use warnings;

use base 'Exporter';

use Carp qw(croak);
use HTTP::Headers::Util qw(_split_header_words);

our $VERSION = 0.02;

our @EXPORT_OK = qw(parse_wwwa);

sub parse_wwwa {
   my ($string) = @_;

   my @parts = split_header_words( $string);

   my $challenge = $parts[0]->[0];
   my %challenges;

   PART:
   for my $part ( @parts ) {
      my ($maybe_challenge, $challenge_check) = @{$part};

      if ( !defined $challenge_check ) {
         $challenge = ucfirst lc $maybe_challenge;
      }

      my ($key, $value) = ($part->[-2], $part->[-1]);
      if ( !defined $value ) {
         if ( !exists $challenges{$challenge} ) {
            $challenges{$challenge} = {};
         }
         next PART;
      }

      my $lc_key = lc $key;
      if ( $challenge eq 'Basic' &&
         $lc_key eq 'realm' &&
         exists $challenges{$challenge}->{$lc_key}
      ) {
         croak 'only one realm is allowed';
      }

      $challenges{$challenge}->{lc $key} = $value;
   }

   if ( exists $challenges{Basic} && !exists $challenges{Basic}->{realm} ) {
      croak 'realm parameter is missing';
   }

   return %challenges;
}

sub split_header_words {
    my @res = &_split_header_words;
    for my $arr (@res) {
      for (my $i = @$arr - 2; $i >= 0; $i -= 2) {
          $arr->[$i] = $arr->[$i];
      }
    }
    return @res;
}

1;

__END__