use
5.010;
our
$VERSION
=
'1.001004'
;
our
$AUTHORITY
=
'cpan:KENTNL'
;
use
Moose
qw( with has )
;
sub
open_file {
my
(
$self
,
$file
) = validated_list( \
@_
,
file
=> {
isa
=> File, }, );
$self
->
log
->debug(
"Opening $file"
);
$self
->_file(
$file
);
$self
->_filehandle(
$self
->_objdump );
return
1;
}
sub
next_section {
my
(
$self
) =
@_
;
my
$re
=
$self
->_section_header_identifier;
my
$fh
=
$self
->_filehandle;
while
(
my
$line
= <
$fh
> ) {
next
if
$line
!~
$re
;
my
(
$header
,
$offset
) = ( $+{header}, $+{offset} );
$self
->_state( {
header
=>
$header
,
offset
=>
$offset
} );
$self
->
log
->info(
"objdump -D -F : Section $header at $offset"
);
return
1;
}
$self
->_clear_file;
$self
->_clear_filehandle;
$self
->_clear_state;
return
0;
}
sub
section_offset {
my
(
$self
) =
@_
;
if
( not
$self
->_has_state ) {
$self
->
log
->logcroak(
'Invalid call to section_offset outside of file scan'
);
return
;
}
return
hex
(
$self
->_state->{offset} );
}
sub
section_size {
my
(
$self
) =
@_
;
$self
->
log
->logcroak(
'Can\'t perform section_size on this type of object.'
);
return
;
}
sub
section_name {
my
(
$self
) =
@_
;
if
( not
$self
->_has_state ) {
$self
->
log
->logcroak(
'Invalid call to section_name outside of file scan'
);
return
;
}
return
$self
->_state->{header};
}
sub
can_compute_size {
return
0;
}
has
_header_regex
=> (
isa
=> RegexpRef,
ro,
default
=>
sub
{
return
qr/<(?<header>[^>]+)>/
;
},
);
has
_offset_regex
=> (
isa
=> RegexpRef,
ro,
default
=>
sub
{
return
qr/[(]File Offset:\s*(?<offset>0x[0-9a-f]+)[)]/
;
},
);
has
_section_header_identifier
=> (
isa
=> RegexpRef, ro, lazy_build, );
has
_file
=> (
isa
=> File, rw,
clearer
=>
'_clear_file'
, );
has
_filehandle
=> (
isa
=> FileHandle, rw,
clearer
=>
'_clear_filehandle'
, );
has
_state
=> (
isa
=> HashRef,
rw,
predicate
=>
'_has_state'
,
clearer
=>
'_clear_state'
,
);
__PACKAGE__->meta->make_immutable;
no
Moose;
sub
_build__section_header_identifier {
my
(
$self
) =
@_
;
my
$header
=
$self
->_header_regex;
my
$offset
=
$self
->_offset_regex;
return
qr/${header}\s*${offset}:/
;
}
sub
_objdump_win32 {
my
(
$self
) =
@_
;
my
(
$stdout
,
$result
) = Capture::Tiny::capture_stdout(
sub
{
system
'objdump'
,
qw( -D -F )
,
$self
->_file->realpath->absolute;
},
);
if
(
$result
!= 0 ) {
$self
->
log
->logconfess(
qq{An error occured requesting section data from objdump $^E $@ }
);
}
open
my
$fh
,
'<'
, \
$stdout
or
do
{
$self
->
log
->logconfess(
qq{An error occured making a string IO filehandle $! $@ }
);
};
return
$fh
;
}
sub
_objdump {
my
(
$self
) =
@_
;
if
(
'MSWin32'
eq $^O or
$ENV
{OBJDUMP_SLURP} ) {
return
$self
->_objdump_win32;
}
if
(
open
my
$fh
,
q{-|}
,
q{objdump}
,
qw( -D -F )
,
$self
->_file->realpath->absolute ) {
return
$fh
;
}
$self
->
log
->logconfess(
qq{An error occured requesting section data from objdump $! $@ }
);
return
;
}
1;