summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Win32/Exe/PE
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2010-05-12 16:54:37 +0000
committerNorbert Preining <preining@logic.at>2010-05-12 16:54:37 +0000
commit661c41a09e39a182865e0b51e34cc995a0dc96e8 (patch)
tree2f79bb1406e22fdcb2587be8ffda6c0c609d7932 /Master/tlpkg/tlperl/lib/Win32/Exe/PE
parentb645030efc22e13c2498a1522083634ab91b2de1 (diff)
move tlperl.straw to tlperl
git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Win32/Exe/PE')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Win32/Exe/PE/Header.pm26
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Win32/Exe/PE/Header/PE32.pm69
2 files changed, 95 insertions, 0 deletions
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;