From 661c41a09e39a182865e0b51e34cc995a0dc96e8 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Wed, 12 May 2010 16:54:37 +0000 Subject: move tlperl.straw to tlperl git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/tlperl/lib/Win32/Exe/PE/Header.pm | 26 ++++++++ .../tlpkg/tlperl/lib/Win32/Exe/PE/Header/PE32.pm | 69 ++++++++++++++++++++++ 2 files changed, 95 insertions(+) create mode 100755 Master/tlpkg/tlperl/lib/Win32/Exe/PE/Header.pm create mode 100755 Master/tlpkg/tlperl/lib/Win32/Exe/PE/Header/PE32.pm (limited to 'Master/tlpkg/tlperl/lib/Win32/Exe/PE') diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/PE/Header.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/PE/Header.pm new file mode 100755 index 00000000000..03888fedbd8 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Win32/Exe/PE/Header.pm @@ -0,0 +1,26 @@ +# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/PE/Header.pm $ $Author: autrijus $ +# $Revision: #5 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $ + +package Win32::Exe::PE::Header; + +use strict; +use base 'Win32::Exe::PE'; +use constant SUBFORMAT => ( + Magic2 => 'v', + LMajor => 'C', + LMinor => 'C', + CodeSize => 'V', + IDataSize => 'V', + UDataSize => 'V', + EntryPointRVA => 'V', + BaseOfCode => 'V', + Data => 'a*', +); +use constant MEMBER_CLASS => 'Data'; +use constant DISPATCH_FIELD => 'Magic2'; +use constant DISPATCH_TABLE => ( + 0x20b => 'PE::Header::PE32Plus', + '*' => 'PE::Header::PE32', +); + +1; diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/PE/Header/PE32.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/PE/Header/PE32.pm new file mode 100755 index 00000000000..ad8e641f40b --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Win32/Exe/PE/Header/PE32.pm @@ -0,0 +1,69 @@ +# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/PE/Header/PE32.pm $ $Author: autrijus $ +# $Revision: #8 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $ + +package Win32::Exe::PE::Header::PE32; + +use strict; +use base 'Win32::Exe::PE::Header'; +use constant SUBFORMAT => ( + BaseOfData => 'V', + ImageBase => 'V', + SectionAlign => 'V', + FileAlign => 'V', + OSMajor => 'v', + OSMinor => 'v', + UserMajor => 'v', + UserMinor => 'v', + SubsysMajor => 'v', + SubsysMinor => 'v', + _ => 'a4', + ImageSize => 'V', + HeaderSize => 'V', + FileChecksum => 'V', + SubsystemTypeId => 'v', + DLLFlags => 'v', + StackReserve => 'V', + StackCommit => 'V', + HeapReserve => 'V', + HeapCommit => 'V', + LoaderFlags => 'V', + NumDataDirs => 'V', + 'DataDirectory' => [ + 'a8', '{$NumDataDirs}', 1 + ], + 'Section' => [ + 'a40', '{$NumSections}', 1 + ], + Data => 'a*', +); +use constant SUBSYSTEM_TYPES => [qw( + _ native windows console _ + _ _ posix _ windowsce +)]; +use constant ST_TO_ID => { + map { (SUBSYSTEM_TYPES->[$_] => $_) } (0 .. $#{+SUBSYSTEM_TYPES}) +}; +use constant ID_TO_ST => { reverse %{+ST_TO_ID} }; + +sub st_to_id { + my ($self, $name) = @_; + return $name unless $name =~ /\D/; + return(+ST_TO_ID->{lc($name)} || die "No such type: $name"); +} + +sub id_to_st { + my ($self, $id) = @_; + return(+ID_TO_ST->{$id} || $id); +} + +sub Subsystem { + my ($self) = @_; + return $self->id_to_st($self->SubsystemTypeId); +} + +sub SetSubsystem { + my ($self, $type) = @_; + $self->SetSubsystemTypeId($self->st_to_id($type)); +} + +1; -- cgit v1.2.3