File Coverage

blib/lib/ELF/Writer/Segment.pm

Criterion	Covered	Total	%
statement	26	36	72.2
branch	7	26	26.9
condition	1	3	33.3
subroutine	10	14	71.4
pod	0	8	0.0
total	44	87	50.5

package ELF::Writer::Segment;
use Moo 2;
use Carp;
use ELF::Writer;
use namespace::clean;

*VERSION= *ELF::Writer::VERSION;

# ABSTRACT: Object representing the fields of one program segment in an ELF file.


our (%type_to_sym, %type_from_sym);
ELF::Writer::_init_enum(\%type_to_sym, \%type_from_sym,
	'null'    => 0, # Ignored entry in program header table
	'load'    => 1, # Load segment into program address space
	'dynamic' => 2, # Dynamic linking information
	'interp'  => 3, # Specifies location of string defining path to interpreter
	'note'    => 4, # Specifies location of auxillary information
	'shlib'   => 5, # ??
	'phdr'    => 6, # Specifies location of the program header loaded into process image
);
has type => ( is => 'rw', default => sub { 1 }, coerce => sub {
	my $x= $type_from_sym{$_[0]};
	defined $x? $x
		: (int($_[0]) == $_[0])? $_[0]
		: croak "$_[0] is not a valid 'type'"
});
sub type_sym {
	my $self= shift;
	$self->type($_[0]) if @_;
	my $v= $self->type;
	$type_to_sym{$v} || $v
}


has offset      => ( is => 'rw' );
has virt_addr   => ( is => 'rw' );
has phys_addr   => ( is => 'rw' );

has filesize    => ( is => 'rw' );
*size= *filesize; # alias

has memsize     => ( is => 'rw' );


has flags       => ( is => 'rw', default => sub { 5 } );

sub flag_readable {
	my ($self, $value)= @_;
	$self->flags( $self->flags & ~1 | ($value? 1 : 0) )
		if defined $value;
	$self->flags & 1;
}

sub flag_writable {
	my ($self, $value)= @_;
	$self->flags( $self->flags & ~2 | ($value? 2 : 0) )
		if defined $value;
	$self->flags & 2;
}

sub flag_executable {
	my ($self, $value)= @_;
	$self->flags( $self->flags & ~4 | ($value? 4 : 0) )
		if defined $value;
	$self->flags & 4;
}

has align       => ( is => 'rw' );


has data        => ( is => 'rw' );
has data_start  => ( is => 'rw', default => sub { 0 } );

sub data_offset { $_[0]->offset + $_[0]->data_start }

# These are overwritten on each call to Writer->serialize
has _index => ( is => 'rw' );
sub _name { "segment ".shift->_index }
sub _required_file_alignment { $_[0]->align || 1 }

sub BUILD {
	my ($self, $params)= @_;
	defined $params->{flag_readable}
		and $self->flag_readable($params->{flag_readable});
	defined $params->{flag_writeable}
		and $self->flag_writeable($params->{flag_writeable});
	defined $params->{flag_executable}
		and $self->flag_executable($params->{flag_executable});
}


sub coerce {
	my ($class, $thing)= @_;
	return (ref $thing && ref($thing)->isa(__PACKAGE__))? $thing : $class->new($thing);
}

sub clone {
	my $self= shift;
	return bless { %$self }, ref $self;
}

1;

__END__