our
$DIGEST
;
sub
_find_digest_class
{
$DIGEST
||=
do
{
my
$pkg
;
foreach
my
$x
qw(SHA1 MD5)
{
my
$candidate
=
"Digest::$x"
;
if
(
$candidate
->
require
()) {
$pkg
=
$candidate
;
last
;
}
}
$pkg
;
};
}
sub
new
{
my
$class
=
shift
;
my
$self
=
$class
->SUPER::new(
@_
);
$self
->id;
$self
->{_notes} = {};
return
$self
;
}
sub
id
{
my
$self
=
shift
;
local
$@ =
undef
;
$self
->{_id} ||=
do
{
my
$pkg
= _find_digest_class() ||
die
"Could not find Digest class"
;
my
$digest
=
$pkg
->new;
$digest
->add(
map
{
defined
$_
?
$_
:
''
} (
time
(), {},
rand
(),
$self
->method,
$self
->uri,
$self
->protocol));
$self
->headers->scan(
sub
{
$digest
->add(
join
(
':'
,
$_
[0],
$_
[1]));
});
$digest
->hexdigest;
};
die
$@
if
$@;
$self
->{_id};
}
sub
clone
{
my
$self
=
shift
;
my
$clone
=
$self
->SUPER::clone;
my
$cloned_notes
= dclone
$self
->notes;
foreach
my
$note
(
keys
%$cloned_notes
) {
$clone
->notes(
$note
=>
$cloned_notes
->{
$note
} );
}
return
$clone
;
}
sub
notes
{
my
$self
=
shift
;
my
$key
=
shift
;
return
$self
->{_notes}
unless
$key
;
my
$value
=
$self
->{_notes}{
$key
};
if
(
@_
) {
$self
->{_notes}{
$key
} =
$_
[0];
}
return
$value
;
}
sub
original_uri
{
my
$self
=
shift
;
my
$uri
=
$self
->uri->clone;
if
(
my
$host
=
$self
->notes(
'original_host'
)) {
$uri
->host(
$host
);
}
return
$uri
;
}
sub
requires_name_lookup
{
my
$self
=
shift
;
return
!
$self
->notes(
'resolved_ip'
) &&
(
$self
->uri->can(
'host'
) &&
$self
->uri->host() !~ /^
$RE
{net}{IPv4}$/);
}
sub
format
{
my
$self
=
shift
;
my
$scheme
=
$self
->uri->scheme;
my
$pkg
=
"Gungho::Request::$scheme"
;
Class::Inspector->loaded(
$pkg
) or
$pkg
->
require
or
die
;
my
$protocol
=
$pkg
->new;
$protocol
->
format
(
$self
);
}
1;