diff options
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Win32/Exe/ResourceData.pm')
-rwxr-xr-x | Master/tlpkg/tlperl.straw/lib/Win32/Exe/ResourceData.pm | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/Win32/Exe/ResourceData.pm b/Master/tlpkg/tlperl.straw/lib/Win32/Exe/ResourceData.pm new file mode 100755 index 00000000000..b33647d519c --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Win32/Exe/ResourceData.pm @@ -0,0 +1,58 @@ +# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/ResourceData.pm $ $Author: autrijus $ +# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $ + +package Win32::Exe::ResourceData; + +use strict; +use base 'Win32::Exe::Base'; +use constant FORMAT => ( + VirtualAddress => 'V', + Size => 'V', + CodePage => 'V', +); + +sub Data { + my ($self) = @_; + return $self->{data} if defined $self->{data}; + + my $section = $self->first_parent('Resources'); + my $addr = $self->VirtualAddress or return; + return $section->substr( + $addr - $section->VirtualAddress, + $self->Size + ); +} + +sub SetData { + my ($self, $data) = @_; + $self->{data} = $data; +} + +sub object { + my ($self) = @_; + return $self->{object}; +} + +sub path { + my ($self) = @_; + return $self->parent->path; +} + +sub initialize { + my ($self) = @_; + + my ($base) = $self->path or return; + $base =~ /^#RT_(?!ICON$)(\w+)$/ or return; + $self->VirtualAddress or return; + + my $data = $self->Data; + my $class = ucfirst(lc($1)); + $class =~ s/_(\w)/\U$1/g; + $class = $self->require_class("Resource::$class") or return; + + my $obj = $class->new(\$data, { parent => $self }); + $obj->initialize; + $self->{object} = $obj; +} + +1; |