my
$LOGGER
= Log::Log4perl->get_logger();
has
'http_response'
=> (
is
=>
'ro'
,
isa
=>
'HTTP::Response'
,
handles
=>
qr/.*/
);
has
'xml_document'
=> (
is
=>
'ro'
,
isa
=>
'XML::LibXML::Document'
,
lazy_build
=> 1 );
has
'reuters_status'
=> (
is
=>
'ro'
,
isa
=>
'Int'
,
lazy_build
=> 1 );
has
'reuters_errors'
=> (
is
=>
'ro'
,
isa
=>
'ArrayRef[HashRef]'
,
lazy_build
=> 1 );
sub
_build_xml_document{
my
(
$self
) =
@_
;
my
$content
=
$self
->http_response->content();
return
XML::LibXML->load_xml(
string
=>
$content
);
}
sub
_build_reuters_status{
my
(
$self
) =
@_
;
my
$doc
=
eval
{
$self
->xml_document();
};
if
(
my
$err
= $@ ){
$LOGGER
->
warn
(
"Cannot build XML document: $err. Parsing: "
.
$self
->content());
return
100;
}
my
(
$status
) =
$doc
->documentElement()->findnodes(
'//status'
);
unless
(
$status
){
$LOGGER
->debug(
"NO status in response. Assuming success (10)"
);
return
10;
}
return
$status
->getAttribute(
'code'
) // 100;
}
sub
_build_reuters_errors{
my
(
$self
) =
@_
;
my
$doc
=
eval
{
$self
->xml_document() };
if
(
my
$err
= $@ ){
return
[ {
code
=> 10000,
error
=>
'Cannot parse response: '
.$@ } ];
}
my
@r
= ();
my
@error_nodes
=
$doc
->findnodes(
'//status/error'
);
foreach
my
$elt
(
@error_nodes
){
push
@r
, {
code
=>
$elt
->getAttribute(
'code'
) // 10000,
error
=>
$elt
->textContent() //
'No text content'
};
}
return
\
@r
;
}
sub
is_reuters_success{
my
(
$self
) =
@_
;
return
$self
->reuters_status() == 10 ||
$self
->reuters_status() == 20;
}
sub
reuters_errors_string{
my
(
$self
) =
@_
;
return
join
(
', '
,
map
{
$_
->{code}.
':'
.
$_
->{error} } @{
$self
->reuters_errors()} );
}
sub
has_reuters_error{
my
(
$self
,
$error_code
) =
@_
;
return
!!
grep
{
$_
->{code} eq
$error_code
} @{
$self
->reuters_errors()};
}
__PACKAGE__->meta->make_immutable();
1;