move tlperl.straw to tlperl

git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751

25 files changed, 1541 insertions, 0 deletions

diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Base.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Base.pm
new file mode 100755
index 00000000000..a90ec19c451
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Base.pm
@@ -0,0 +1,35 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Base.pm $ $Author: autrijus $
+# $Revision: #8 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Base;
+
+use strict;
+use base 'Parse::Binary';
+use constant BASE_CLASS => 'Win32::Exe';
+use constant FORMAT => (
+    Data	    => 'a',
+);
+
+sub align {
+    my ($self, $value, $boundary) = @_;
+    my $n = ($value % $boundary) or return $value;
+    return($value + $boundary - $n);
+}
+
+sub pad {
+    my ($self, $value, $bounary) = @_;
+    my $x = length($value) % $bounary or return '';
+    return "\0" x ($bounary - $x);
+}
+
+sub decode_ucs2 {
+    my ($self, $string) = @_;
+    return join('', map chr($_), unpack("v*", $string));
+}
+
+sub encode_ucs2 {
+    my ($self, $string) = @_;
+    return pack("v*", map ord($_), split(//, $string));
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/DataDirectory.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/DataDirectory.pm
new file mode 100755
index 00000000000..e544ed372a3
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/DataDirectory.pm
@@ -0,0 +1,13 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/DataDirectory.pm $ $Author: autrijus $
+# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::DataDirectory;
+
+use strict;
+use base 'Win32::Exe::Base';
+use constant FORMAT => (
+    VirtualAddress  => 'V',
+    Size	    => 'V',
+);
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/DebugDirectory.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/DebugDirectory.pm
new file mode 100755
index 00000000000..f87cc0062be
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/DebugDirectory.pm
@@ -0,0 +1,19 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/DebugDirectory.pm $ $Author: autrijus $
+# $Revision: #5 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::DebugDirectory;
+
+use strict;
+use base 'Win32::Exe::Base';
+use constant FORMAT => (
+    Flags	    => 'V',
+    TimeStamp	    => 'V',
+    VersionMajor    => 'v',
+    VersionMinor    => 'v',
+    Type	    => 'V',
+    Size	    => 'V',
+    VirtualAddress  => 'V',
+    Offset	    => 'V',
+);
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/DebugTable.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/DebugTable.pm
new file mode 100755
index 00000000000..c861ee2397b
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/DebugTable.pm
@@ -0,0 +1,12 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/DebugTable.pm $ $Author: autrijus $
+# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::DebugTable;
+
+use strict;
+use base 'Win32::Exe::Base';
+use constant FORMAT => (
+    'DebugDirectory'	=> [ 'a28', '*', 1 ],
+);
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/IconFile.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/IconFile.pm
new file mode 100755
index 00000000000..8c24160951d
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/IconFile.pm
@@ -0,0 +1,60 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/IconFile.pm $ $Author: autrijus $
+# $Revision: #9 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::IconFile;
+
+use strict;
+use base 'Win32::Exe::Base';
+use constant FORMAT => (
+    Magic		=> 'a2',
+    Type		=> 'v',
+    Count		=> 'v',
+    'Resource::Icon'	=> [ 'a16', '{$Count}', 1 ],
+    Data		=> 'a*',
+);
+use constant DEFAULT_ARGS => (
+    Magic   => "\0\0",
+    Type    => 1,
+    Count   => 0,
+    Data    => '',
+);
+use constant DISPATCH_FIELD => 'Magic';
+use constant DISPATCH_TABLE => (
+    "\0\0"  => '',
+    "MZ"    => '__BASE__',
+    '*'	    => sub { die "Invalid icon file header: $_[1]" },
+);
+
+sub icons {
+    my $self = shift;
+    $self->members(@_);
+}
+
+sub set_icons {
+    my ($self, $icons) = @_;
+    $self->SetCount(scalar @$icons);
+    $self->set_members('Resource::Icon' => $icons);
+    $self->refresh;
+
+    foreach my $idx (0 .. $#{$icons}) {
+	$self->icons->[$idx]->SetImageOffset(length($self->dump));
+	$self->SetData( $self->Data . $icons->[$idx]->Data );
+    }
+
+    $self->refresh;
+}
+
+sub dump_iconfile {
+    my $self = shift;
+    my @icons = $self->icons;
+    my $obj = $self->require_class('IconFile')->new;
+    $obj->set_icons(\@icons);
+    return $obj->dump;
+}
+
+sub write_iconfile {
+    my ($self, $filename) = @_;
+    $self->write_file($filename, $self->dump_iconfile);
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/PE.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/PE.pm
new file mode 100755
index 00000000000..55251562786
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/PE.pm
@@ -0,0 +1,24 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/PE.pm $ $Author: autrijus $
+# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::PE;
+
+use strict;
+use base 'Win32::Exe';
+use constant SUBFORMAT => (
+    Machine	    => 'v',
+    NumSections	    => 'v',
+    TimeStamp	    => 'V',
+    SymbolTable	    => 'V',
+    _		    => 'a4',
+    OptHeaderSize   => 'v',
+    Characteristics => 'v',
+    Data	    => 'a*',
+);
+use constant DISPATCH_FIELD => 'OptHeaderSize';
+use constant DISPATCH_TABLE => (
+    '0' => '',
+    '*' => 'PE::Header',
+);
+
+1;
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;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Resource.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Resource.pm
new file mode 100755
index 00000000000..433be495ea6
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Resource.pm
@@ -0,0 +1,38 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Resource.pm $ $Author: autrijus $
+# $Revision: #7 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Resource;
+
+use strict;
+use base 'Win32::Exe::Base';
+
+sub object {
+    my ($self) = @_;
+    return $self;
+}
+
+sub path {
+    my ($self) = @_;
+    return $self->parent->path;
+}
+
+sub CodePage {
+    return 1252;
+}
+
+sub PathName {
+    my ($self) = @_;
+    return $self->{pathname} || $self->first_parent('ResourceEntry')->PathName;
+}
+
+sub SetPathName {
+    my ($self, $value) = @_;
+    $self->{pathname} = $value;
+}
+
+sub Data {
+    my ($self) = @_;
+    return $self->dump;
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/GroupIcon.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/GroupIcon.pm
new file mode 100755
index 00000000000..c2349ec7383
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/GroupIcon.pm
@@ -0,0 +1,57 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Resource/GroupIcon.pm $ $Author: autrijus $
+# $Revision: #5 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Resource::GroupIcon;
+
+use strict;
+use base 'Win32::Exe::Resource';
+use constant FORMAT => (
+    Magic		=> 'a2',
+    Type		=> 'v',
+    Count		=> 'v',
+    'Resource::Icon'    => [ 'a14', '{$Count}', 1 ],
+);
+use constant DEFAULT_ARGS => (
+    Magic   => "\0\0",
+    Type    => 1,
+    Count   => 0,
+);
+use constant DELEGATE_SUBS => (
+    'IconFile'	=> [ 'dump_iconfile', 'write_iconfile' ],
+);
+
+sub icons {
+    my $self = shift;
+    $self->members(@_);
+}
+
+sub set_icons {
+    my ($self, $icons) = @_;
+
+    $self->SetCount(scalar @$icons);
+    $self->set_members('Resource::Icon' => $icons);
+
+    my $rsrc = $self->first_parent('Resources') or return;
+
+    foreach my $idx (0 .. $#{$icons}) {
+	my $icon = $self->icons->[$idx];
+	$icon->SetId($idx+1);
+	$rsrc->insert($self->icon_name($icon->Id), $icons->[$idx]);
+    }
+}
+
+sub substr {
+    my ($self, $id) = @_;
+    my $section = $self->first_parent('Resources');
+    return $section->res_data($self->icon_name($id));
+}
+
+sub icon_name {
+    my ($self, $id) = @_;
+    my @icon_name = split("/", $self->PathName, -1);
+    $icon_name[1] = "#RT_ICON";
+    $icon_name[2] = "#$id";
+    return join("/", @icon_name);
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/Icon.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/Icon.pm
new file mode 100755
index 00000000000..a6b5348acbf
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/Icon.pm
@@ -0,0 +1,54 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Resource/Icon.pm $ $Author: autrijus $
+# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Resource::Icon;
+
+use strict;
+use base 'Win32::Exe::Resource';
+use constant FORMAT => (
+    Width	    => 'C',
+    Height	    => 'C',
+    ColorCount	    => 'C',
+    _		    => 'C',
+    Planes	    => 'v',
+    BitCount	    => 'v',
+    ImageSize	    => 'V',
+    I_RVA1	    => 'v',
+    I_RVA2	    => 'v',
+);
+
+sub Id {
+    my ($self) = @_;
+    return $self->I_RVA1;
+}
+
+sub SetId {
+    my ($self, $value) = @_;
+    return $self->SetI_RVA1($value);
+}
+
+sub ImageOffset {
+    my ($self) = @_;
+    return $self->I_RVA1 + (($self->I_RVA2 || 0) * 65536);
+}
+
+sub SetImageOffset {
+    my ($self, $value) = @_;
+    $self->SetI_RVA1($value % 65536);
+    $self->SetI_RVA2(int($value / 65536));
+}
+
+sub Data {
+    my ($self) = @_;
+    return $self->parent->substr($self->ImageOffset, $self->ImageSize);
+}
+
+sub dump {
+    my ($self) = @_;
+    my $parent = $self->parent;
+    my $dump = $self->SUPER::dump;
+    substr($dump, -2, 2, '') unless $parent->is_type('IconFile');
+    return $dump;
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/Manifest.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/Manifest.pm
new file mode 100755
index 00000000000..28d6ecaeff4
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/Manifest.pm
@@ -0,0 +1,60 @@
+package Win32::Exe::Resource::Manifest;
+
+use strict;
+use base 'Win32::Exe::Resource';
+use constant FORMAT => (
+    Data        => 'a*',
+);
+
+sub get_manifest {
+    my ($self ) = @_;
+    return $self->dump;    
+}
+
+sub set_manifest {
+    my ( $self, $xmltext ) = @_;
+    $self->SetData( $self->encode_manifest($xmltext) );
+    my $rsrc = $self->first_parent('Resources');
+    $rsrc->remove("/#RT_MANIFEST");
+    $rsrc->insert("/#RT_MANIFEST/#1/#0" => $self);
+    $rsrc->refresh;
+}
+
+sub update_manifest {
+    my ( $self, $xmltext ) = @_;
+    $self->SetData( $self->encode_manifest($xmltext) );
+}
+
+sub encode_manifest {
+    my ($self, $string) = @_;
+    return pack("a*", $string);
+}
+
+sub default_manifest {
+    my ( $self ) = @_;
+    my $defman =  <<'W32EXEDEFAULTMANIFEST'
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+    <assemblyIdentity processorArchitecture="x86" version="0.0.0.0" type="win32" name="Win32.Exe.Application" />
+    <description>Win32.Exe.Application</description>
+    <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
+        <security>
+            <requestedPrivileges>
+                <requestedExecutionLevel level="asInvoker" uiAccess="false" />
+            </requestedPrivileges>
+        </security>
+    </trustInfo>
+    <dependency>
+        <dependentAssembly>
+            <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" publicKeyToken="6595b64144ccf1df" language="*" processorArchitecture="x86" />
+        </dependentAssembly>
+    </dependency>
+</assembly>
+W32EXEDEFAULTMANIFEST
+;
+
+
+    return $defman;
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/Version.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/Version.pm
new file mode 100755
index 00000000000..98adfbb9b22
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Resource/Version.pm
@@ -0,0 +1,364 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Resource/Version.pm $ $Author: autrijus $
+# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Resource::Version;
+
+use strict;
+use base 'Win32::Exe::Resource';
+use constant FORMAT => (
+    Data		=> 'a*',
+);
+use constant FIXED_INFO => [qw(
+    Signature StrucVersion FileVersionMS FileVersionLS
+    ProductVersionMS ProductVersionLS FileFlagsMask FileFlags
+    FileOS FileType FileSubtype FileDateMS FileDateLS
+)];
+use constant STRING_INFO => [qw(
+    Comments CompanyName FileDescription FileVersion InternalName
+    LegalCopyright LegalTrademarks OriginalFilename PrivateBuild
+    ProductName ProductVersion SpecialBuild FileNumber ProductNumber
+)];
+use constant FI_TO_ID => {
+    map { (FIXED_INFO->[$_] => $_) } (0 .. $#{+FIXED_INFO})
+};
+use constant LC_TO_SI => {
+    (map { (lc($_) => $_) } @{+STRING_INFO}, keys %{+FI_TO_ID}),
+    (map { (lc($_) => $_) } map { /^(.+)MS$/ ? $1 : () } keys %{+FI_TO_ID}),
+};
+
+sub fi_to_id {
+    my ($self, $name) = @_;
+    return(+FI_TO_ID->{$name});
+}
+
+sub lc_to_si {
+    my ($self, $name) = @_;
+    return(+LC_TO_SI->{lc($name)} || $name);
+}
+
+sub info {
+    my ($self) = @_;
+    return $self->{info};
+}
+
+sub set_info {
+    my ($self, $info) = @_;
+    $self->{info} = $info;
+}
+
+sub initialize {
+    my ($self) = @_;
+    $self->set_info($self->decode_info($self->Data));
+    die 'Invalid structure' unless $self->check;
+}
+
+sub refresh {
+    my ($self) = @_;
+    $self->SetData($self->encode_info($self->info));
+    my $rsrc = $self->first_parent('Resources');
+    $rsrc->remove("/#RT_VERSION");
+    $rsrc->insert("/#RT_VERSION/#1/#0" => $self);
+    $rsrc->refresh;
+    $self->initialize;
+}
+
+sub encode_info {
+    my ($self, $info) = @_;
+
+    my $key = shift(@$info);
+    $key = $self->encode_ucs2("$key\0");
+
+    my $val = shift(@$info);
+    my ($type, $vallen);
+
+    if (ref $val) {
+	$type   = 0;                   # binary
+	$val    = pack('V*', @$val);
+	$vallen = length($val);
+    }
+    elsif (length $val) {
+	$type   = 1;                          # text;
+	$val    = $self->encode_ucs2("$val\0");
+	$vallen = length($val) / 2;
+    }
+    else {
+	$type   = 1;
+	$vallen = 0;
+    }
+
+    my @sub_objects;
+    foreach my $sub_info (@$info) {
+	my $obj = $self->encode_info($sub_info);
+	push(@sub_objects, $obj);
+    }
+
+    my $buf = pack('v3', 0, $vallen, $type) . $key;
+    $buf .= $self->pad($buf, 4);
+    $buf .= $val;
+
+    foreach my $sub_object (@sub_objects) {
+	$buf .= $self->pad($buf, 4);
+	$buf .= $sub_object;
+    }
+
+    substr($buf, 0, 2, pack('v', length($buf)));
+    return $buf;
+}
+
+sub decode_info {
+    my $self  = shift;
+    my $level = $_[1] || 1;
+
+    my ($len, $vallen, $type) = unpack('v3', $_[0]);
+    die 'No record length' unless $len;
+    die 'Long length' if $len > length($_[0]);
+
+    my $buf = substr($_[0], 0, $len);
+    substr($_[0], 0, $self->align($len, 4)) = '';
+
+    my $endkey = index($buf, "\0\0", 6);
+    while ($endkey > 0 and ($endkey % 2)) {
+	$endkey = index($buf, "\0\0", $endkey + 1);
+    }
+
+    die 'Invalid endkey' if $endkey < 6 or $endkey > $len - $vallen;;
+
+    my $key    = substr($buf, 6, $endkey - 6);
+    my $u8_key = $self->decode_ucs2($key);
+
+    my @res = ($u8_key);
+    $endkey = $self->align($endkey + 2, 4);
+    substr($buf, 0, $endkey, '');
+
+    if ($vallen) {
+	$vallen *= 2 if $level == 4;    # only for strings
+	my $val = substr($buf, 0, $vallen);
+	if ($type) {
+	    $val = $self->decode_ucs2($val);
+	    $val =~ s/\0\z//;
+	}
+	else {
+	    $val = [ unpack('V*', $val) ];
+	}
+	push(@res, $val);
+	$vallen = $self->align($vallen, 4);
+
+	substr($buf, 0, $vallen) = '';
+    }
+    else {
+	push(@res, '');
+    }
+
+    while (length $buf) {
+	push(@res, $self->decode_info($buf, $level + 1));
+    }
+
+    return \@res;
+}
+
+sub empty_info {
+    [ 'VS_VERSION_INFO', [ 0xFEEF04BD, 1 << 16, (0) x 11 ] ];
+}
+
+sub check_info {
+    my ($self, $info) = @_;
+    return 0 unless $info->[0] eq 'VS_VERSION_INFO';
+    return 0 unless ref($info->[1]);
+    return 0 unless $info->[1][0] == 0xFEEF04BD;
+    return 0 unless $self->check_sub_info($info);
+    return 1;
+}
+
+sub check_sub_info {
+    my ($self, $info) = @_;
+    return unless UNIVERSAL::isa($info, 'ARRAY');
+    return if @$info < 2;
+    return unless defined($info->[0]) and defined($info->[1]);
+    return unless !ref($info->[0]) and length($info->[0]);
+    return unless !ref($info->[1]) or UNIVERSAL::isa($info->[1], 'ARRAY');
+    foreach my $idx (2 .. @$info - 1) {
+	return 0 unless $self->check_sub_info($info->[$idx]);
+    }
+    return 1;
+}
+
+sub get {
+    my ($self, $name) = @_;
+    $name =~ s!\\!/!g;
+    $name = $self->lc_to_si($name);
+    my $info = $self->info;
+
+    if ($name eq '/') {
+	return undef unless ref $info->[1];
+	return $info->[1];
+    }
+
+    my $fixed = $self->fi_to_id($name);
+    if (defined $fixed) {
+	my $struct = $info->[1];
+	return undef unless $struct && ref($struct);
+	return $struct->[$fixed];
+    }
+
+    $fixed = $self->fi_to_id($name.'MS');
+    if (defined $fixed) {
+	my $struct = $info->[1];
+	return undef unless $struct && ref($struct);
+	my $ms = $struct->[$fixed];
+	my $ls = $struct->[ $self->fi_to_id($name.'LS') ];
+	return join(',', $self->split_dword($ms), $self->split_dword($ls));
+    }
+
+    my $s;
+    if ($name =~ s!^/!!) {
+	$s = $info;
+	while ($name =~ s!^([^/]+)/!!) {
+	    $s = $self->find_info($s, $1) or return undef;
+	}
+    }
+    else {
+	$s = $self->find_info($info, 'StringFileInfo') or return undef;
+	if (my $cur_trans = $self->{cur_trans}) {
+	    $s = $self->find_info($s, $cur_trans, 1) or return undef;
+	}
+	else {
+	    $s = $s->[2] or return undef;
+	    $self->{cur_trans} = $s->[0];
+	}
+    }
+
+    $s = $self->find_info($s, $name) or return undef;
+    return $s->[1];
+}
+
+sub set {
+    my ($self, $name, $value) = @_;
+    $name =~ s!\\!/!g;
+    $name = $self->lc_to_si($name);
+    my $info = $self->info;
+
+    if ($name eq '/') {
+	if (!defined $value) {
+	    $info->[1] = '';
+	}
+	elsif (UNIVERSAL::isa($value, 'ARRAY') and @$value == 13) {
+	    $info->[1] = $value;
+	}
+	else {
+	    die 'Invalid array assigned';
+	}
+    }
+
+    my $fixed = $self->fi_to_id($name);
+    if (defined $fixed) {
+	$value = oct($value) if $value =~ /^0/;
+	$info->[1][$fixed] = $value;
+	return;
+    }
+
+    $fixed = $self->fi_to_id($name.'MS');
+    if (defined $fixed) {
+	my @value = split(/[,.]/, $value, -1);
+	if (@value == 4) {
+	    $value[0] = ($value[0] << 16) | $value[1];
+	    $value[1] = ($value[2] << 16) | $value[3];
+	    splice(@value, 2);
+	}
+
+	die 'Invalid MS/LS value' if @value != 2;
+	$info->[1][$fixed] = $value[0] || 0;
+	$info->[1][$self->fi_to_id($name.'LS')] = $value[1] || 0;
+	return;
+    }
+
+    my $container = $info;
+
+    if ($name =~ s!^/!!) {
+	while ($name =~ s!^([^/]+)/!!) {
+	    my $n = $1;
+	    my $s = $self->find_info($container, $n);
+	    unless ($s) {
+		$s = [ $n => '' ];
+		push(@$container, $s);
+	    }
+	    $container = $s;
+	}
+    }
+    else {
+	my $s = $self->find_info($container, 'StringFileInfo');
+	unless ($s) {
+	    $s = [ StringFileInfo => '' ];
+	    push(@$container, $s);
+	}
+	$container = $s;
+
+	my $cur_trans = $self->{cur_trans};
+	unless ($cur_trans) {
+	    if (@$container > 2) {
+		$cur_trans = $container->[2][0];
+	    }
+	    else {
+		$cur_trans = '000004B0';    # Language Neutral && CP 1200 = Unicode
+	    }
+	    $self->{cur_trans} = $cur_trans;
+	}
+
+	$s = $self->find_info($container, $cur_trans, 1);
+	unless ($s) {
+	    $s = [ $cur_trans => '' ];
+	    push(@$container, $s);
+	}
+	$container = $s;
+    }
+
+    my ($kv, $kv_index) = $self->find_info($container, $name);
+    unless ($kv) {
+	push(@$container, [ $name => $value ]) if defined $value;
+	return;
+    }
+
+    if (defined $value) {
+	$kv->[1] = $value;
+    }
+    else {
+	splice(@$container, $kv_index, 1);
+    }
+}
+
+sub check {
+    my $self = shift;
+    return $self->check_info($self->info);
+}
+
+sub find_info {
+    my ($self, $info, $name, $ignore) = @_;
+    my $index;
+
+    if ($name =~ /^#(\d+)$/) {
+	$index = $1 - 1 + 2;
+	$index = undef if $index < 2 || $index >= @$info;
+    }
+    else {
+	for (2 .. @$info - 1) {
+	    my $e = $info->[$_];
+	    if ($e->[0] eq $name or $ignore && lc($e->[0]) eq lc($name)) {
+		$index = $_;
+		last;
+	    }
+	}
+    }
+    if ($index) {
+	return $info->[$index] unless wantarray;
+	return ($info->[$index], $index);
+    }
+
+    return undef unless wantarray;
+    return (undef, undef);
+}
+
+sub split_dword {
+    my ($self, $dword) = @_;
+    return ($dword >> 16), ($dword & 0xFFFF);
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceData.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceData.pm
new file mode 100755
index 00000000000..b33647d519c
--- /dev/null
+++ b/Master/tlpkg/tlperl/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;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceEntry.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceEntry.pm
new file mode 100755
index 00000000000..a44a65daf3d
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceEntry.pm
@@ -0,0 +1,69 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/ResourceEntry.pm $ $Author: autrijus $
+# $Revision: #7 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::ResourceEntry;
+
+use strict;
+use base 'Win32::Exe::Base';
+use constant FORMAT => (
+    Data	    => 'V',
+    E_RVA	    => 'V',
+);
+use constant HIGH_BIT => 0x80_00_00_00;
+use Win32::Exe::ResourceData;
+
+sub high_bit {
+    my ($self) = @_;
+    return +HIGH_BIT;
+}
+
+sub path {
+    my ($self) = @_;
+    return $self->parent->path;
+}
+
+sub PathName {
+    my ($self) = @_;
+    return join('/', '', $self->path, $self->Name);
+}
+
+sub VirtualAddress {
+    my ($self) = @_;
+    $self->E_RVA & ~($self->high_bit);
+}
+
+sub SetVirtualAddress {
+    my ($self, $data) = @_;
+    $self->SetE_RVA($data | $self->IsDirectory);
+}
+
+sub IsDirectory {
+    my ($self) = @_;
+    $self->E_RVA & ($self->high_bit);
+}
+
+sub initialize {
+    my ($self) = @_;
+    my $section = $self->first_parent('Resources');
+    my $data = $section->substr($self->VirtualAddress, 12);
+    my $res_data = Win32::Exe::ResourceData->new(\$data, { parent => $self });
+    $res_data->initialize;
+    $self->{res_data} = $res_data;
+}
+
+sub Data {
+    my ($self) = @_;
+    return $self->{res_data}->Data;
+}
+
+sub CodePage {
+    my ($self) = @_;
+    return $self->{res_data}->CodePage;
+}
+
+sub object {
+    my ($self) = @_;
+    return $self->{res_data}->object;
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceEntry/Id.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceEntry/Id.pm
new file mode 100755
index 00000000000..39e35b4000d
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceEntry/Id.pm
@@ -0,0 +1,47 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/ResourceEntry/Id.pm $ $Author: autrijus $
+# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::ResourceEntry::Id;
+
+use strict;
+use base 'Win32::Exe::ResourceEntry';
+use constant SUBFORMAT => (
+    Id		    => 'V',
+);
+use constant RESOURCE_TYPES => [qw(
+    _		CURSOR		BITMAP		ICON	    MENU
+    DIALOG	STRING		FONTDIR		FONT	    ACCELERATOR
+    RCDATA	MESSAGETABLE	GROUP_CURSOR	_	    GROUP_ICON
+    _		VERSION		DLGINCLUDE	_	    PLUGPLAY
+    VXD		ANICURSOR	ANIICON		HTML        MANIFEST
+)];
+use constant RT_TO_ID => {
+    map { ('RT_'.RESOURCE_TYPES->[$_] => $_) }
+	(0 .. $#{+RESOURCE_TYPES})
+};
+use constant ID_TO_RT => { reverse %{+RT_TO_ID} };
+
+sub Name {
+    my ($self) = @_;
+    my $id = $_[0]->Id;
+    $id = $self->id_to_rt($id) if $self->parent->depth < 1;
+    return "#$id";
+}
+
+sub SetName {
+    my ($self, $name) = @_;
+    $name =~ s/^#//;
+    $self->SetId( $self->rt_to_id($name) );
+}
+
+sub id_to_rt {
+    my ($self, $id) = @_;
+    return(+ID_TO_RT->{$id} || $id);
+}
+
+sub rt_to_id {
+    my ($self, $rt) = @_;
+    return(+RT_TO_ID->{$rt} || $rt);
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceEntry/Name.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceEntry/Name.pm
new file mode 100755
index 00000000000..8f6cd1d8784
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceEntry/Name.pm
@@ -0,0 +1,42 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/ResourceEntry/Name.pm $ $Author: autrijus $
+# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::ResourceEntry::Name;
+
+use strict;
+use base 'Win32::Exe::ResourceEntry';
+use constant SUBFORMAT => (
+    N_RVA	    => 'V',
+);
+
+sub NameAddress {
+    my ($self) = @_;
+    $self->N_RVA & ~($self->high_bit);
+}
+
+sub SetNameAddress {
+    my ($self, $data) = @_;
+    $self->SetN_RVA($data | $self->IsDirectory);
+}
+
+sub IsEscaped {
+    my ($self) = @_;
+    $self->N_RVA & ($self->high_bit);
+}
+
+sub Name {
+    my ($self) = @_;
+    my $section = $self->first_parent('Resources');
+    my $addr = $self->NameAddress;
+    my $size = unpack('v', $section->substr($addr, 2));
+    my $ustr = $section->substr($addr + 2, $size * 2);
+    my $name = $self->decode_ucs2($ustr);
+    $name =~ s{([%#/])}{sprintf('%%%02X', ord($1))}eg;
+    return $name;
+}
+
+sub SetName {
+    die "XXX unimplemented";
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceTable.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceTable.pm
new file mode 100755
index 00000000000..7fe9fa1d5dd
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/ResourceTable.pm
@@ -0,0 +1,35 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/ResourceTable.pm $ $Author: autrijus $
+# $Revision: #5 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::ResourceTable;
+
+use strict;
+use base 'Win32::Exe::Base';
+use constant FORMAT => (
+    DebugDirectory	    => 'V',
+    TimeStamp		    => 'V',
+    VersionMajor	    => 'v',
+    VersionMinor	    => 'v',
+    NumNameEntry	    => 'v',
+    NumIdEntry		    => 'v',
+    'ResourceEntry::Name'   => [ 'a8', '{$NumNameEntry}', 1 ],
+    'ResourceEntry::Id'	    => [ 'a8', '{$NumIdEntry}', 1 ],
+);
+
+sub set_path {
+    my ($self, $path) = @_;
+    $self->{path} = $path;
+}
+
+sub path {
+    my ($self) = @_;
+    wantarray ? @{$self->{path}} : $self->{path};
+}
+
+sub depth {
+    my ($self) = @_;
+    scalar @{$self->{path}};
+}
+
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Section.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Section.pm
new file mode 100755
index 00000000000..d08f91590f7
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Section.pm
@@ -0,0 +1,154 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section.pm $ $Author: autrijus $
+# $Revision: #9 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Section;
+
+use strict;
+use base 'Win32::Exe::Base';
+use constant FORMAT => (
+    Name	    => 'Z8',
+    VirtualSize	    => 'V',
+    VirtualAddress  => 'V',
+    FileSize	    => 'V',
+    FileOffset	    => 'V',
+    RelocOffset	    => 'V',
+    LineNumOffset   => 'V',
+    NumReloc	    => 'v',
+    NumLineNum	    => 'v',
+    Flags	    => 'V',
+);
+use constant DISPATCH_FIELD => 'Name';
+use constant DISPATCH_TABLE => (
+    '.text'	=> 'Section::Code',
+    '.debug'	=> 'Section::Debug',
+    '.data'	=> 'Section::Data',
+    '.rdata'	=> 'Section::Data',
+    '.bss'	=> 'Section::Data',
+    '.edata'	=> 'Section::Exports',
+    '.idata'	=> 'Section::Imports',
+    '.rsrc'	=> 'Section::Resources',
+);
+
+use constant CONTAINS_CODE  => 0x20;
+use constant CONTAINS_IDATA => 0x40;
+use constant CONTAINS_UDATA => 0x80;
+
+sub Data {
+    my ($self) = @_;
+    $self->{data} ||= do {
+	my $v_size = $self->VirtualSize;
+	my $f_size = $self->FileSize or return("\0" x $v_size);
+
+	$f_size = $v_size if $v_size < $f_size;
+
+	my $data = $self->parent->substr($self->FileOffset, $f_size);
+	$data .= ("\x0" x ($v_size - length($data)));
+	$data;
+    }
+}
+
+sub SetData {
+    my ($self, $data) = @_;
+    my $pad_size = length($1) if $data =~ s/(\0*)\z//;
+
+    my $exe = $self->parent;
+    $exe->OptHeaderSize == 224 or die "Unsupported binary format";
+
+    my $index = $self->sibling_index;
+    my $data_size = length($data);
+
+    my $f_size	= $self->align($data_size, $exe->FileAlign);
+    my $v_size	= $self->align($data_size, $exe->SectionAlign);
+    my $f_extra = $f_size - $self->FileSize;
+    my $v_extra = $v_size - $self->align($self->VirtualSize, $exe->SectionAlign);
+
+    $self->pad_data($f_extra, $v_extra) if $f_extra;
+
+    $self->SetVirtualSize($data_size + $pad_size);
+    $data .= ("\0" x ($self->FileSize - $data_size));
+
+    $exe->substr($self->FileOffset, length($data), $data);
+    $self->update_size;
+}
+
+sub update_size {
+    my ($self) = @_;
+
+    my $exe = $self->parent;
+    my $v_addr = $self->VirtualAddress;
+    my $v_size = $self->VirtualSize;
+
+    foreach my $dir ($exe->data_directories) {
+	next unless $dir->VirtualAddress == $v_addr;
+	$dir->SetSize($v_size);
+	$dir->refresh;
+    }
+}
+
+sub pad_data {
+    my ($self, $f_extra, $v_extra) = @_;
+
+    my $exe = $self->parent;
+    my $offset = $self->FileOffset + $self->FileSize;
+
+    $exe->update_debug_directory($offset, $f_extra);
+
+    my $exe_size = $exe->size;
+    if ($exe_size > $offset) {
+	my $buf = $exe->substr($offset, ($exe_size - $offset));
+	$exe->substr($offset + $f_extra, length($buf), $buf);
+    }
+
+    $exe->set_size($exe_size + $f_extra);
+    if ($f_extra > 0) {
+	$exe->SetData($exe->Data . ("\0" x $f_extra));
+    }
+    else {
+	$exe->SetData(substr($exe->Data, 0, $f_extra));
+    }
+
+    my $index = $self->sibling_index;
+    foreach my $section (@{$self->siblings}) {
+	next if $section->sibling_index <= $index;
+	$section->update_offset($f_extra, $v_extra);
+    }
+
+    $self->SetFileSize($self->FileSize + $f_extra);
+    $exe->SetImageSize($exe->ImageSize + $v_extra);
+
+    my $flags = $self->Flags;
+    $exe->SetCodeSize($exe->CodeSize + $f_extra)   if $flags & CONTAINS_CODE;
+    $exe->SetIDataSize($exe->IDataSize + $f_extra) if $flags & CONTAINS_IDATA;
+    $exe->SetUDataSize($exe->UDataSize + $f_extra) if $flags & CONTAINS_UDATA;
+}
+
+sub update_offset {
+    my ($self, $f_extra, $v_extra) = @_;
+    return unless $f_extra > 0;
+
+    my $exe = $self->parent;
+    my $v_addr = $self->VirtualAddress;
+
+    $self->SetVirtualAddress( $v_addr + $v_extra );
+    $self->SetFileOffset( $self->FileOffset + $f_extra );
+
+    foreach my $dir ($exe->data_directories) {
+	next unless $dir->VirtualAddress == $v_addr;
+	$dir->SetVirtualAddress($self->VirtualAddress);
+    }
+}
+
+sub substr {
+    my $self    = shift;
+    my $data    = $self->Data;
+    my $offset  = shift;
+    my $length  = @_ ? shift(@_) : (length($data) - $offset);
+    my $replace = shift;
+
+    return substr($data, $offset, $length) if !defined $replace;
+
+    substr($data, $offset, $length, $replace);
+    $self->SetData($data);
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Code.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Code.pm
new file mode 100755
index 00000000000..726707c3064
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Code.pm
@@ -0,0 +1,9 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Code.pm $ $Author: autrijus $
+# $Revision: #4 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Section::Code;
+
+use strict;
+use base 'Win32::Exe::Section';
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Data.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Data.pm
new file mode 100755
index 00000000000..033d8f504e3
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Data.pm
@@ -0,0 +1,9 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Data.pm $ $Author: autrijus $
+# $Revision: #4 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Section::Data;
+
+use strict;
+use base 'Win32::Exe::Section';
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Debug.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Debug.pm
new file mode 100755
index 00000000000..e59ac4b3287
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Debug.pm
@@ -0,0 +1,9 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Debug.pm $ $Author: autrijus $
+# $Revision: #4 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Section::Debug;
+
+use strict;
+use base 'Win32::Exe::Section';
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Exports.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Exports.pm
new file mode 100755
index 00000000000..9d1d5117555
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Exports.pm
@@ -0,0 +1,9 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Exports.pm $ $Author: autrijus $
+# $Revision: #4 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Section::Exports;
+
+use strict;
+use base 'Win32::Exe::Section';
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Imports.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Imports.pm
new file mode 100755
index 00000000000..e736a043f15
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Imports.pm
@@ -0,0 +1,9 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Imports.pm $ $Author: autrijus $
+# $Revision: #4 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Section::Imports;
+
+use strict;
+use base 'Win32::Exe::Section';
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Resources.pm b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Resources.pm
new file mode 100755
index 00000000000..afbc41e7309
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Win32/Exe/Section/Resources.pm
@@ -0,0 +1,260 @@
+# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Resources.pm $ $Author: autrijus $
+# $Revision: #10 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
+
+package Win32::Exe::Section::Resources;
+
+use strict;
+use base 'Win32::Exe::Section';
+use constant DELEGATE_SUBS => (
+    'ResourceEntry'	=> [ 'high_bit' ],
+    'ResourceEntry::Id'	=> [ 'rt_to_id', 'id_to_rt' ],
+);
+
+sub initialize {
+    my $self = shift;
+    $self->make_table(0);
+    return $self;
+}
+
+sub table {
+    my $self = shift;
+    return $self->{table};
+}
+
+sub make_table {
+    my ($self, $offset, @path) = @_;
+    my $image = $self->substr($offset);
+    my $table = $self->require_class('ResourceTable')->new(
+	\$image, {
+	    parent  => $self,
+	    path    => \@path
+	},
+    );
+
+    foreach my $entry ($table->members) {
+	if ($entry->IsDirectory) {
+	    $self->make_table($entry->VirtualAddress, @path, $entry->Name);
+	}
+	else {
+	    $self->{table}{$entry->PathName} = $entry;
+	}
+    }
+}
+
+sub names {
+    my ($self) = @_;
+    my @rv = sort keys %{$self->{table}};
+    wantarray ? @rv : \@rv;
+}
+
+sub resources {
+    my ($self, $name) = @_;
+    my @rv = map $self->{table}{$_}, $self->names;
+    wantarray ? @rv : \@rv;
+}
+
+sub remove {
+    my ($self, $name) = @_;
+    delete $self->{table}{$_} for grep /^\Q$name\E/, $self->names;
+}
+
+sub insert {
+    my ($self, $name, $res) = @_;
+    $self->{table}{$name} = $res;
+}
+
+sub res {
+    my ($self, $name) = @_;
+    return $self->{table}{$name};
+}
+
+sub res_data {
+    my ($self, $name) = @_;
+    my $res = $self->res($name) or return;
+    return $res->Data;
+}
+
+sub res_codepage {
+    my ($self, $name) = @_;
+    my $res = $self->res($name) or return;
+    return $res->CodePage;
+}
+
+sub res_object {
+    my ($self, $name) = @_;
+    my $res = $self->res($name) or return;
+    return $res->object;
+}
+
+sub res_image {
+    my ($self, $name) = @_;
+    my $res = $self->res($name) or return;
+    my $object = $res->object or return $res->Data;
+    return $object->dump;
+}
+
+sub first_object {
+    my ($self, $type) = @_;
+    foreach my $object (grep $_, map $_->object, $self->resources) {
+	return $object if !$type or $object->is_type($type);
+    }
+    return undef;
+}
+
+sub objects {
+    my ($self, $type) = @_;
+    return grep { $type ? $_->is_type($type) : 1 }
+	   grep { $_ } map { $_->object } $self->resources;
+}
+
+sub refresh {
+    my $self = shift;
+
+    my $res_num = @{$self->resources} or return pack('V*', (0) x 4);
+    my $entry_size = $self->entry_size(scalar $self->names);
+    my $data_entry_size = 16 * $res_num;
+
+    my %str_addr;
+    my $str_image  = '';
+    my $str_offset = $entry_size + $data_entry_size;
+
+    foreach my $name ($self->names) {
+	$name =~ s!^/!!;
+	foreach my $chunk (split("/", $name, -1)) {
+	    $chunk =~ /^#/ and next;
+	    $chunk =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+	    next if exists $str_addr{$chunk};
+
+	    die "String too long" if length($chunk) > 0xFFFF;
+
+	    my $addr = length($str_image);
+	    my $str = $self->encode_ucs2($chunk);
+	    $str_image .= pack('v', length($str) / 2) . $str;
+
+	    $str_addr{$chunk} = $addr + $str_offset;
+	}
+    }
+    $str_image .= $self->pad($str_image, 8);
+
+    my %data_entry_addr;
+    my $data_entry_image = '';
+    my $data_image       = '';
+    my $data_offset      = $str_offset + length($str_image);
+
+    foreach my $name ($self->names) {
+	$data_entry_addr{$name} = $entry_size + length($data_entry_image);
+
+	my $data_addr = $data_offset + length($data_image) + $self->VirtualAddress;
+	$data_entry_image .= pack(
+	    'V4',
+	    $data_addr,
+	    length($self->res_data($name)),
+	    $self->res_codepage($name),
+	    0,
+	);
+	$data_image .= $self->res_data($name);
+	$data_image .= $self->pad($data_image, 8);
+    }
+
+    my $entry_image = '';
+    $self->make_entry(
+	\$entry_image,
+	'',
+	[$self->names],
+	\%str_addr,
+	\%data_entry_addr,
+    );
+
+    length($entry_image) == $entry_size or die "Wrong size";
+
+    $self->SetData(
+	join('', $entry_image, $data_entry_image, $str_image, $data_image)
+    );
+}
+
+sub entry_size {
+    my ($self, $names) = @_;
+
+    my %entries;
+    foreach my $name (grep length, @$names) {
+	$name =~ m!^/([^/]*)(.*)! or next;
+	push(@{ $entries{$1} }, $2);
+    }
+
+    my $count = keys %entries or return 0;
+    my $size = 8 * ($count + 2);
+    $size += $self->entry_size($_) for values %entries;
+    return $size;
+}
+
+sub make_entry {
+    my ($self, $image_ref, $prefix, $names, $str_addr, $data_entry_addr) = @_;
+
+    if (@$names == 1 and !length($names->[0])) {
+	return $data_entry_addr->{$prefix};
+    }
+
+    my %entries;
+    foreach my $name (@$names) {
+	$name =~ m!^/([^/]*)(.*)! or next;
+	my ($path, $name) = ($1, $2);
+	my $type = ($path =~ /^#/) ? 'id' : 'name';
+	push(@{ $entries{$type}{$path} }, $name);
+    }
+
+    my $addr = length($$image_ref);
+    my $num_name = keys %{ $entries{name} };
+    my $num_id   = keys %{ $entries{id} };
+    $$image_ref .= pack('V3vv', 0, 0, 0, $num_name, $num_id);
+
+    my $entry_offset = length($$image_ref);
+    $$image_ref .= pack('V*', (0) x (($num_name + $num_id) * 2));
+
+    foreach my $entry ($self->sort_entry(\%entries)) {
+	my ($type, $name) = @$entry;
+	my $id;
+	if ($type eq 'id') {
+	    $id = $name;
+	    $id =~ s/^#//;
+	    $id = $self->rt_to_id($id);
+	}
+	else {
+	    (my $n = $name) =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+	    $id = $str_addr->{$n} | $self->high_bit;
+	}
+
+	my $rva = $self->make_entry(
+	    $image_ref,
+	    "$prefix/$name",
+	    $entries{$type}{$name},
+	    $str_addr,
+	    $data_entry_addr,
+	);
+
+	substr($$image_ref, $entry_offset, 8) = pack('VV', $id, $rva);
+	$entry_offset += 8;
+    }
+
+    return ($addr | $self->high_bit);
+}
+
+sub sort_entry {
+    my ($self, $entries) = @_;
+
+    my @names = map { $_->[1] } sort { $a->[0] cmp $b->[0] } map {
+	my $name = lc($_);
+	$name =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+	[ $name => $_ ];
+    } keys %{ $entries->{name} };
+
+    my @ids = map "#$_", sort {
+	$self->rt_to_id($a) <=> $self->rt_to_id($b)
+    } map substr($_, 1), keys %{ $entries->{id} };
+
+    return(
+	(map [ name => $_ ], @names),
+	(map [ id   => $_ ], @ids),
+    );
+}
+
+1;