File Coverage

blib/lib/Parse/WWWAuthenticate.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	8	8	100.0
condition	8	9	88.8
subroutine	7	7	100.0
pod	2	2	100.0
total	65	66	98.4

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.03;

our @EXPORT_OK = qw(parse_wwwa);

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

   my @parts = split_header_words( $string);

   my $challenge;
   my @challenges;

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

      if ( !defined $challenge_check ) {
         $challenge = ucfirst lc $maybe_challenge;
         push @challenges, { name => $challenge, params => {} };
      }

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

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

      $challenges[-1]->{params}->{lc $key} = $value;
   }

   for my $challenge ( @challenges ) {
       if ( $challenge->{name} eq 'Basic' && !exists $challenge->{params}->{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__