view release on metacpan or  search on metacpan

lib/ELF/Writer.pm  view on Meta::CPAN

		$data .= $_->data;
	}
	return $data;
}

sub _serialize_segment_header {
	my ($self, $seg)= @_;
	
	# Faster than checking bit lengths on every field ourself
	use warnings FATAL => 'pack';
	
	# Make sure all required attributes are defined
	defined $seg->$_ or croak "Attribute $_ is not defined"
		for qw( type offset virt_addr align );
	
	my $filesize= $seg->filesize;
	$filesize= length($seg->data) + $seg->data_offset
		unless defined $filesize;
	
	my $align= $seg->align;
	my $memsize= $seg->memsize;
	$memsize= int(($filesize + $align - 1) / $align) * $align
		unless defined $memsize;
	
	# 'flags' moves depending on 32 vs 64 bit, so changing the pack string isn't enough
	return $self->_encoding < 2?
		pack($self->_segment_header_packstr,
			$seg->type, $seg->offset, $seg->virt_addr, $seg->phys_addr || 0,
			$filesize, $memsize, $seg->flags, $seg->align
		)
		: pack($self->_segment_header_packstr,
			$seg->type, $seg->flags, $seg->offset, $seg->virt_addr,
			$seg->phys_addr || 0, $filesize, $memsize, $seg->align
		);
}

sub _serialize_section_header {
	my ($self, $sec)= @_;
	
	# Make sure all required attributes are defined
	defined $sec->$_ or croak "Attribute $_ is not defined"
		for qw( type name flags addr offset size link info addralign entsize );
	
	# Faster than checking bit lengths on every field ourself
	use warnings FATAL => 'pack';
	
	return pack($self->_section_header_packstr,
		$sec->name, $sec->type, $sec->flags, $sec->addr, $sec->offset,
		$sec->size, $sec->link, $sec->info, $sec->align, $sec->entry_size
	);
}


sub write_file {
	my ($self, $filename, $mode)= @_;
	$mode= 0755 unless defined $mode;
	require File::Temp;
	my ($fh, $tmpname)= File::Temp::tempfile( $filename.'-XXXXXX' );
	print $fh $self->serialize or croak "write: $!";
	close $fh or croak "close: $!";
	chmod($mode, $tmpname) or croak "chmod: $!";
	rename($tmpname, $filename) or croak "rename: $!";
}

# coerce arrayref of hashrefs into arrayref of objects
sub _coerce_segments {
	my $spec= shift;
	return [ map { (__PACKAGE__.'::Segment')->coerce($_) } @$spec ];
}

# coerce arrayref of hashrefs into arrayref of objects
sub _coerce_sections {
	my $spec= shift;
	return [ map { (__PACKAGE__.'::Section')->coerce($_) } @$spec ];
}

# Overridden by subclasses for machine-specific defaults
sub _apply_section_defaults {
	my ($self, $sec)= @_;
	# Undef type is "null" type 0
	my $type= $sec->type;
	defined $type
		or $sec->type($type= 0);
	my $offset= $sec->offset;
	my $size= $sec->size;
	
	if ($type == 0) { # 'null'
		# Ensure length and offset are zero
		$size= $sec->size(0) unless defined $size;
		$offset= $sec->offset(0) unless defined $offset;
		croak "null section should have offset=0 and size=0"
			if $offset || $size;
	}
	elsif ($type == 8) { # 'nobits'
		# Offset can be set but ensure size is zero
		$size= $sec->size(0) unless defined $size;
		croak "nobits section should have size=0"
			if $size;
		
	}
	else {
		# 'size' is required, but can be computed from 'data' and 'data_offset'.
		if (!defined $size) {
			defined $sec->data or croak "Section must define 'size' or 'data'"; 
			$sec->size($sec->data_start + length($sec->data));
		}
	}
}

# Overridden by subclasses for machine-specific defaults
sub _apply_segment_defaults {
	my ($self, $seg)= @_;
	# Undef type is "null" type 0
	my $type= $seg->type;
	defined $type
		or $seg->type($type= 0);
	my $offset= $seg->offset;
	my $filesize= $seg->filesize;
	
	if ($type == 0) { # 'null'
		# Ensure length and offset are zero