HTTP digest auth client for Catalyst

gistfile1.pl

# do HTTP digest login
sub digest_login_request {
    my ($schema, $username, $pw_override) = @_;
    my $res = request('/login');
    my %digest_hdr = map {
        my @key_val = split /=/, $_, 2; # /
            $key_val[0] = lc $key_val[0];
        $key_val[1] =~ s{"}{}g;    # remove the quotes
        @key_val;
    } split /,\s?/, substr( $res->header('WWW-Authenticate'), 7 ); #/;

    my $uri = '/login';
    my $nc = '00000001';
    my $cnonce = '0fad1cadcafeacab';
    # diag($username);
    my $usr = $schema->resultset('Usr')->find($username);
    my $password = '';
    if ($usr){ $password = $usr->password; }
    if ($pw_override) { $password = $pw_override; } # diag($password);
    my $qop = 'auth';
    my $A1 = sprintf('%s:%s:%s', $username, $digest_hdr{realm}, $password); # diag($A1);
    my $A2 = sprintf('%s:%s', 'GET', $uri); # diag($A2);
    my $response = sprintf(
        '%s:%s:%s:%s:%s:%s', 
        md5_hex($A1), $digest_hdr{nonce}, $nc, $cnonce, 
        $qop, md5_hex($A2)); # diag($response);
    my $auth_hdr = sprintf('Digest username="%s", ', $username);
    $auth_hdr .= sprintf('realm="%s", ', $digest_hdr{realm});
    $auth_hdr .= sprintf('nonce="%s", ', $digest_hdr{nonce});
    $auth_hdr .= sprintf('uri="%s", ', $uri);
    $auth_hdr .= sprintf('algorithm="%s", ', 'MD5');
    $auth_hdr .= sprintf('response="%s", ', md5_hex($response));
    $auth_hdr .= sprintf('qop="%s", ', $qop);
    $auth_hdr .= sprintf('nc="%s", ', $nc);
    $auth_hdr .= sprintf('cnonce="%s", ', $cnonce);
    $auth_hdr .= sprintf('opaque="%s", ', $digest_hdr{opaque});
    # diag('Auth header: ' . $auth_hdr);

    my $req = Catalyst::Utils::request('/login');
    $req->header('Authorization' => $auth_hdr);
    return $req;
}