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


line stmt bran cond sub pod time code
1             package ELF::Writer::Segment;
2 1     1   3 use Moo 2;
  1         15  
  1         4  
3 1     1   209 use Carp;
  1         1  
  1         61  
4 1     1   3 use ELF::Writer;
  1         1  
  1         16  
5 1     1   3 use namespace::clean;
  1         1  
  1         6  
6              
7             *VERSION= *ELF::Writer::VERSION;
8              
9             # ABSTRACT: Object representing the fields of one program segment in an ELF file.
10              
11              
12             our (%type_to_sym, %type_from_sym);
13             ELF::Writer::_init_enum(\%type_to_sym, \%type_from_sym,
14             'null' => 0, # Ignored entry in program header table
15             'load' => 1, # Load segment into program address space
16             'dynamic' => 2, # Dynamic linking information
17             'interp' => 3, # Specifies location of string defining path to interpreter
18             'note' => 4, # Specifies location of auxillary information
19             'shlib' => 5, # ??
20             'phdr' => 6, # Specifies location of the program header loaded into process image
21             );
22             has type => ( is => 'rw', default => sub { 1 }, coerce => sub {
23             my $x= $type_from_sym{$_[0]};
24             defined $x? $x
25             : (int($_[0]) == $_[0])? $_[0]
26             : croak "$_[0] is not a valid 'type'"
27             });
28             sub type_sym {
29 1     1 0 7 my $self= shift;
30 1 50       3 $self->type($_[0]) if @_;
31 1         3 my $v= $self->type;
32 1 50       375 $type_to_sym{$v} || $v
33             }
34              
35              
36             has offset => ( is => 'rw' );
37             has virt_addr => ( is => 'rw' );
38             has phys_addr => ( is => 'rw' );
39              
40             has filesize => ( is => 'rw' );
41             *size= *filesize; # alias
42              
43             has memsize => ( is => 'rw' );
44              
45              
46             has flags => ( is => 'rw', default => sub { 5 } );
47              
48             sub flag_readable {
49 0     0 0 0 my ($self, $value)= @_;
50 0 0       0 $self->flags( $self->flags & ~1 | ($value? 1 : 0) )
    0          
51             if defined $value;
52 0         0 $self->flags & 1;
53             }
54              
55             sub flag_writable {
56 0     0 0 0 my ($self, $value)= @_;
57 0 0       0 $self->flags( $self->flags & ~2 | ($value? 2 : 0) )
    0          
58             if defined $value;
59 0         0 $self->flags & 2;
60             }
61              
62             sub flag_executable {
63 0     0 0 0 my ($self, $value)= @_;
64 0 0       0 $self->flags( $self->flags & ~4 | ($value? 4 : 0) )
    0          
65             if defined $value;
66 0         0 $self->flags & 4;
67             }
68              
69             has align => ( is => 'rw' );
70              
71              
72             has data => ( is => 'rw' );
73             has data_start => ( is => 'rw', default => sub { 0 } );
74              
75 5     5 0 17 sub data_offset { $_[0]->offset + $_[0]->data_start }
76              
77             # These are overwritten on each call to Writer->serialize
78             has _index => ( is => 'rw' );
79 0     0   0 sub _name { "segment ".shift->_index }
80 1 50   1   3 sub _required_file_alignment { $_[0]->align || 1 }
81              
82             sub BUILD {
83 3     3 0 28 my ($self, $params)= @_;
84             defined $params->{flag_readable}
85 3 50       7 and $self->flag_readable($params->{flag_readable});
86             defined $params->{flag_writeable}
87 3 50       4 and $self->flag_writeable($params->{flag_writeable});
88             defined $params->{flag_executable}
89 3 50       42 and $self->flag_executable($params->{flag_executable});
90             }
91              
92              
93             sub coerce {
94 1     1 0 2 my ($class, $thing)= @_;
95 1 50 33     26 return (ref $thing && ref($thing)->isa(__PACKAGE__))? $thing : $class->new($thing);
96             }
97              
98             sub clone {
99 1     1 0 2 my $self= shift;
100 1         8 return bless { %$self }, ref $self;
101             }
102              
103             1;
104              
105             __END__