Initial Commit

database/perl/vendor/lib/Win32/Exe/Base.pm

@@ -0,0 +1,34 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/DataDirectory.pm

@@ -0,0 +1,12 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+package Win32::Exe::DataDirectory;
+
+use strict;
+use base 'Win32::Exe::Base';
+use constant FORMAT => (
+    VirtualAddress  => 'V',
+    Size	    => 'V',
+);
+
+1;

database/perl/vendor/lib/Win32/Exe/DebugDirectory.pm

@@ -0,0 +1,18 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/DebugTable.pm

@@ -0,0 +1,11 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+package Win32::Exe::DebugTable;
+
+use strict;
+use base 'Win32::Exe::Base';
+use constant FORMAT => (
+    'DebugDirectory'	=> [ 'a28', '*', 1 ],
+);
+
+1;

database/perl/vendor/lib/Win32/Exe/IconFile.pm

@@ -0,0 +1,59 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/InsertResourceSection.pm

@@ -0,0 +1,122 @@
+#########################################################################################
+# Package       Win32::Exe::InsertResourceSection
+# Description:  Insert Resource Section
+# Created       Sun May 02 17:32:55 2010
+# SVN Id        $Id: InsertResourceSection.pm 2 2010-11-30 16:40:31Z mark.dootson $
+# Copyright:    Copyright (c) 2010 Mark Dootson
+# Licence:      This program is free software; you can redistribute it 
+#               and/or modify it under the same terms as Perl itself
+#########################################################################################
+
+package Win32::Exe::InsertResourceSection;
+
+#########################################################################################
+
+use strict;
+use warnings;
+use Exporter;
+use base qw( Exporter );
+use Carp;
+use Win32::Exe;
+
+our $VERSION = '0.17';
+our @EXPORT = qw( insert_pe_resource_section );
+
+sub _is_win { ($^O =~ /^mswin/i) }
+
+if (_is_win()) {
+    require XSLoader;
+    XSLoader::load('Win32::Exe::InsertResourceSection', $VERSION);
+}
+
+sub create_resource_section {
+    my $filename = shift;
+    
+    croak('Invalid filename') if $filename !~ /\.(dll|exe)$/i;
+    croak('Filename not found') if !-f $filename;
+    
+    if(!_is_win()) {
+        warn 'Cannot add resource section to PE files on this platform. Requires MSWin';
+        return undef;
+    }
+    
+    my $replacecode;
+    if($filename =~ /\.(dll|exe)$/i) {
+        #VFT_APP = 0x1
+        #VFT_DLL = 0x2
+        #VFT_DRV = 0x3
+        #VFT_FONT = 0x4
+        #VFT_VXD = 0x5
+        #VFT_STATIC_LIB = 0x7
+        if(lc($1) eq 'exe') {
+            $replacecode = '01';
+        } elsif(lc($1) eq 'dll') {
+            $replacecode = '02';
+        } else {
+            croak('Invalid filename');
+        }
+    } else {
+        croak('Invalid filename');
+    }
+
+    my @verdata = qw(
+        400234000000560053005F0056004500
+        5200530049004F004E005F0049004E00
+        46004F0000000000BD04EFFE00000100
+        00000000000000000000000000000000
+        3F0000000000000004000400XX000000
+        000000000000000000000000A0010000
+        010053007400720069006E0067004600
+        69006C00650049006E0066006F000000
+        7C010000010030003000300030003000
+        34004200300000002400020001004300
+        6F006D00700061006E0079004E006100
+        6D00650000000000200000002C000200
+        0100460069006C006500440065007300
+        6300720069007000740069006F006E00
+        00000000200000002400020001004600
+        69006C00650056006500720073006900
+        6F006E00000000002000000024000200
+        010049006E007400650072006E006100
+        6C004E0061006D006500000020000000
+        2800020001004C006500670061006C00
+        43006F00700079007200690067006800
+        74000000200000002C00020001004C00
+        6500670061006C005400720061006400
+        65006D00610072006B00730000000000
+        200000002C00020001004F0072006900
+        670069006E0061006C00460069006C00
+        65006E0061006D006500000020000000
+        240002000100500072006F0064007500
+        630074004E0061006D00650000000000
+        20000000280002000100500072006F00
+        64007500630074005600650072007300
+        69006F006E0000002000000044000000
+        0100560061007200460069006C006500
+        49006E0066006F000000000024000400
+        00005400720061006E0073006C006100
+        740069006F006E00000000000000B004
+    );   
+    
+    my $verdatahex = join('', @verdata);
+    $verdatahex =~ s/XX/$replacecode/;
+    
+    my $verdataraw = pack('H*', $verdatahex);
+    my $verlen = length($verdataraw);
+    _insert_resource_section($filename, $verdataraw, $verlen);
+}
+
+sub insert_pe_resource_section {
+    my $filename = shift;
+    if(create_resource_section($filename)) {
+        # basic version info resource has been created
+        # we now have to replace the language and original
+        # filename / filename
+        my $exe = Win32::Exe->new($filename);
+        return ($exe->update( info => [ "FileVersion=0.0.0.0" ] )) ? $exe : undef;
+    } else {
+        return undef;
+    }
+}
+
+1;

database/perl/vendor/lib/Win32/Exe/Manifest/Parser.pm

@@ -0,0 +1,902 @@
+#########################################################################################
+# Package       Win32::Exe::Manifest::Parser
+# Description:  XML Parser for Manifests
+# Created       Wed Apr 21 07:54:51 2010
+# SVN Id        $Id: Parser.pm 2 2010-11-30 16:40:31Z mark.dootson $
+# Copyright:    Copyright (c) 2010 Mark Dootson
+# Licence:      This program is free software; you can redistribute it 
+#               and/or modify it under the same terms as Perl itself
+#########################################################################################
+
+package Win32::Exe::Manifest::Parser;
+
+#########################################################################################
+
+use strict;
+use warnings;
+use XML::Simple 2.18;
+use base qw( XML::Simple );
+use Carp;
+
+our $VERSION = '0.15';
+
+=head1 NAME
+
+Win32::Exe::Manifest::Parser - MSWin Application and Assembly manifest handling
+
+=head1 VERSION
+
+This document describes version 0.15 of Win32::Exe::Manifest::Parser, released
+November 30, 2010. 
+
+=head1 DESCRIPTION
+
+This is an internal module from the Win32::Exe distribution supporting
+parsing of application and assembly manifests.
+
+=cut
+
+
+our $BASESCHEMA;
+
+$XML::Simple::PREFERRED_PARSER = 'XML::Parser';
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+sub get_current_schema { $_[0]->{_w32x_current_schema} || $BASESCHEMA; }
+sub set_current_schema { $_[0]->{_w32x_current_schema} = $_[1]; }
+
+#---------------------------------------------------------------
+# override XML Simple methods
+#---------------------------------------------------------------
+
+sub sorted_keys {
+    my($self, $name, $hashref) = @_;
+    my @unsorted = (sort keys(%$hashref));
+    my $schema = $self->get_current_schema();
+    my @sorted = sort { _get_key_ordinal($name,$hashref,$a,$schema) <=> _get_key_ordinal($name,$hashref,$b,$schema) } @unsorted;
+    
+    # set indent
+    my ($namenamespace,$lookupname);
+    if($name =~ /:/) {
+        ($namenamespace,$lookupname) = split(/:/, $name, 2);
+    } else {
+        $lookupname = $name;
+    }
+    if($lookupname) {
+        $self->{opt}->{attrindent} = ( $lookupname =~ /^(assemblyIdentity)$/ )
+            ? 1 : 0;
+    } else {
+        $self->{opt}->{attrindent} = 0;
+    }
+    return ( @sorted );
+}
+
+#--------------------------------------------------------------
+# END XML::Simple overrides
+#--------------------------------------------------------------
+
+sub _get_key_ordinal {
+    my($name,$hashref,$key, $schema) = @_;
+    # some defaults
+    return 1001 if $key eq 'xmlns';
+    return 10000 if $key =~ /^xmlns:.+$/;
+    my ($keynamespace,$lookupkey);
+    if($key =~ /:/) {
+        ($keynamespace,$lookupkey) = split(/:/, $key, 2);
+    } else {
+        $lookupkey = $key;
+    }
+    my ($namenamespace,$lookupname);
+    if($name =~ /:/) {
+        ($namenamespace,$lookupname) = split(/:/, $name, 2);
+    } else {
+        $lookupname = $name;
+    }
+    
+    carp qq(UNKNOWN NAMEKEY NAME $name : $lookupname KEY $key : $lookupkey\n) if (!$lookupname || !$lookupkey);
+    
+    if(ref($hashref->{$key})) {
+        return (exists($schema->{elementtypes}->{$lookupname}->{elements}->{$lookupkey}->{order}))
+            ? $schema->{elementtypes}->{$lookupname}->{elements}->{$lookupkey}->{order}
+            : 9999 ;
+    } else {
+        return (exists($schema->{elementtypes}->{$lookupname}->{attributes}->{$lookupkey}->{order}))
+            ? $schema->{elementtypes}->{$lookupname}->{attributes}->{$lookupkey}->{order}
+            : 9999 ;
+    }
+}
+
+sub get_default_manifest {
+    my $self_or_class = shift;
+    my $defman =  q(<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+    <assemblyIdentity type="win32" version="0.0.0.0" name="Perl.Win32.Application" />
+    <description>Perl.Win32.Application</description>
+    <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
+        <security>
+            <requestedPrivileges>
+                <requestedExecutionLevel level="asInvoker" uiAccess="false" />
+            </requestedPrivileges>
+        </security>
+    </trustInfo>
+</assembly>
+);
+    return $defman;
+}
+
+
+sub validate_manifest_version {
+    return ($_[1] eq '1.0') ? 1 : 0;
+}
+
+sub validate_string {
+    my ($self, $val) = @_;
+    return 1;
+}
+
+sub validate_class_name {
+    my($this, $name) = @_;
+    return ($name =~ /[^A-Za-z0-9\-_\.]/) ? 0 : 1;
+}
+
+sub validate_type {
+    my($this, $type) = @_;
+    return ( $type eq 'win32'); # specification demands lower case
+}
+
+sub validate_public_key {
+    my ($this, $key) = @_;
+    return 1;
+}
+
+sub validate_language {
+    my ($self, $lang) = @_;
+    return 1;
+}
+
+sub validate_architecture {
+    my ($this, $arch) = @_;
+    return 1 if $arch eq '*';
+    # many files seem to uppercase X86 so we'll accept case insensitive data
+    return 1 if $arch =~ /^(x86|msil|ia64|amd64)$/i;
+    return 0;
+}
+
+sub validate_yesno {
+    my ($this, $val) = @_;
+    return ( $val =~ /^(yes|no)$/) ? 1 : 0;
+}
+
+sub validate_truefalse {
+    my ($this, $val) = @_;
+    return ( $val =~ /^(true|false)$/) ? 1 : 0;
+}
+
+sub validate_clsid {
+    my ($this, $clsid) = @_;
+    return ( $clsid =~ /^\{[A-Fa-f0-9]{8}-[A-Fa-f0-9]{4}-[A-Fa-f0-9]{4}-[A-Fa-f0-9]{4}-[A-Fa-f0-9]{12}\}$/ ) ? 1 : 0;
+}
+
+sub validate_int4 {
+    my ($this, $int) = @_;
+    return ( $int =~ /^\d{1,4}$/) ? 1 : 0;
+}
+
+sub validate_int8 {
+    my ($this, $int) = @_;
+    return ( $int =~ /^\d{1,8}$/) ? 1 : 0;
+}
+
+sub validate_flags {
+    my ($this, $flags) = @_;
+    return ( $flags =~ /^(control|hidden|restricted|hasdiskimage)$/i ) ? 1 : 0;
+}
+
+sub validate_level {
+    my ($this, $level) = @_;
+    return ( $level =~ /^(asInvoker|highestAvailable|requireAdministrator)$/ ) ? 1 : 0;
+}
+
+sub validate_hashalg {
+    my ($this, $alg) = @_;
+    return ( $alg =~ /^(SHA1|SHA|MD5|MD4|MD2)$/i ) ? 1 : 0;
+}
+
+sub validate_thread_model {
+    my ($this, $model) = @_;
+    return ( $model =~ /^(Apartment|Free|Both|Neutral)$/i ) ? 1 : 0;
+}
+
+sub validate_hex {
+    my ($this, $hex) = @_;
+    return 1;
+}
+
+sub validate_osid {
+    my ($this, $osid) = @_;
+    return 1 if $osid eq '{e2011457-1546-43c5-a5fe-008deee3d3f0}'; # Windows Vista Compatibility
+    return 1 if $osid eq '{35138b9a-5d96-4fbd-8e2d-a2440225f93a}'; # Windows 7 Compatibility
+    return 0;
+}
+
+sub validate_miscstatus {
+    my ($this, $status) = @_;
+    my @vals = split(/\s*,\s*/, $status);
+    my @allowednames = qw(
+        recomposeonresize onlyiconic insertnotreplace static cantlinkinside canlinkbyole1   
+        islinkobject insideout activatewhenvisible renderingisdeviceindependent    
+        invisibleatruntime alwaysrun actslikebutton actslikelabel nouiactivate    
+        alignable simpleframe setclientsitefirst imemode ignoreativatewhenvisible    
+        wantstomenumerge supportsmultilevelundo
+        );
+    my %allowed;
+    @allowed{@allowednames} = (); 
+    my $returnval = 1;
+    for (@vals) {
+        $returnval = (exists($allowed{$_})) ? 1 : 0;
+        last if !$returnval;
+    }
+    return $returnval;
+}
+
+$BASESCHEMA = __PACKAGE__->get_default_schema();
+
+sub get_default_schema {
+    my $self_or_class = shift;    
+    my $schema = {
+        namespace => {
+            'urn:schemas-microsoft-com:compatibility.v1' => 'cmpv1',
+            'urn:schemas-microsoft-com:asm.v1' => 'asmv1',
+            'urn:schemas-microsoft-com:asm.v2' => 'asmv2',
+            'urn:schemas-microsoft-com:asm.v3' => 'asmv3',
+        },
+        nstranslation => {
+            cmpv1 => 'cmpv1',
+            asmv1 => 'asmv1',
+            asmv2 => 'asmv2',
+            asmv3 => 'asmv3',
+        },
+        namespacelookup => {
+            cmpv1 => 'urn:schemas-microsoft-com:compatibility.v1',
+            asmv1 => 'urn:schemas-microsoft-com:asm.v1',
+            asmv2 => 'urn:schemas-microsoft-com:asm.v2',
+            asmv3 => 'urn:schemas-microsoft-com:asm.v3',
+        },
+        attributes => {
+            manifestVersion         => 'validate_manifest_version',
+            name                    => 'validate_class_name',
+            type                    => 'validate_type',
+            publicKeyToken          => 'validate_public_key',
+            language                => 'validate_language',
+            processorArchitecture   => 'validate_architecture',
+            version                 => 'validate_string',
+            optional                => 'validate_yesno',
+            clsid                   => 'validate_clsid',
+            description             => 'validate_string',
+            threadingModel          => 'validate_thread_model',
+            tlbid                   => 'validate_clsid',
+            progid                  => 'validate_string',
+            helpdir                 => 'validate_string',
+            iid                     => 'validate_clsid',
+            numMethods              => 'validate_int4',
+            resourceid              => 'validate_string',
+            flags                   => 'validate_flags',
+            hashalg                 => 'validate_hashalg',
+            hash                    => 'validate_hex',
+            proxyStubClsid32        => 'validate_string',
+            baseInterface           => 'validate_clsid',
+            versioned               => 'validate_yesno',
+            oldVersion              => 'validate_string',
+            newVersion              => 'validate_string',
+            size                    => 'validate_int8',
+            runtimeVersion          => 'validate_string',
+            Id                      => 'validate_osid',
+            xmlns                   => 'validate_string',
+            level                   => 'validate_level',
+            uiAccess                => 'validate_truefalse',
+            miscStatus              => 'validate_miscstatus',
+            miscStatusIcon          => 'validate_miscstatus',
+            miscStatusContent       => 'validate_miscstatus',
+            miscStatusDocprint      => 'validate_miscstatus',
+            miscStatusThumbnail     => 'validate_miscstatus',
+        },
+        elementtypes => {
+            assembly    =>  {
+                exclusive   => 'none',
+                content     => { elements => 1, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    xmlns           => {
+                        required    => 1,
+                        default     => 'urn:schemas-microsoft-com:asm.v1',
+                    },
+                    manifestVersion => {
+                        required    => 1,
+                        default     => '1.0',
+                        order       => 1002,
+                    },
+                },
+                elements    => {
+                    # files, even from Microsoft, sometimes don't have an assemblyIdentity
+                    assemblyIdentity                => {  min => 0, max => 1, order => 10,  },
+                    compatibility                   => {  min => 0, max => 1, order => 64, },
+                    application                     => {  min => 0, max => 1, order => 66, },
+                    description                     => {  min => 0, max => 1, order => 20,  },
+                    noInherit                       => {  min => 0, max => 1, order => 30, },
+                    noInheritable                   => {  min => 0, max => 1, order => 40, },
+                    comInterfaceExternalProxyStub   => {  min => 0, max => 0, order => 50, },
+                    dependency                      => {  min => 0, max => 0, order => 60, },
+                    file                            => {  min => 0, max => 0, order => 70, },
+                    clrClass                        => {  min => 0, max => 0, order => 80, },
+                    clrSurrogate                    => {  min => 0, max => 0, order => 90, },
+                    trustInfo                       => {  min => 0, max => 1, order => 62, },
+                    windowClass                     => {  min => 0, max => 1, order => 150, },
+                },
+            },
+            trustInfo    =>  {
+                exclusive   => 'none',
+                content     => { elements => 1, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    xmlns           => {
+                        required    => 1,
+                        default     => 'urn:schemas-microsoft-com:asm.v3',
+                    },
+                },
+                elements    => {
+                    security                => {  min => 1, max => 1, order => 10  },
+                },
+            },
+            security    =>  {
+                exclusive   => 'none',
+                content     => { elements => 1, attributes => 0, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                },
+                elements    => {
+                    requestedPrivileges     => {  min => 1, max => 1, order => 10,  },
+                },
+            },
+            requestedPrivileges    =>  {
+                exclusive   => 'none',
+                content     => { elements => 1, attributes => 0, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                },
+                elements    => {
+                    requestedExecutionLevel     => {  min => 1, max => 1 , order => 10, },
+                },
+            },
+            requestedExecutionLevel    =>  {
+                exclusive   => 'none',
+                content     => { elements => 0, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    level           => {
+                        required    => 1,
+                        default     => 'asInvoker',
+                        order       => 1002,
+                    },
+                    uiAccess           => {
+                        required    => 0,
+                        default     => 'false',
+                        order       => 1003,
+                    },
+                },
+                elements    => {
+                },
+            },              
+            compatibility    =>  {
+                exclusive   => 'application',
+                content     => { elements => 1, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    xmlns           => {
+                        required    => 1,
+                        default     => 'urn:schemas-microsoft-com:compatibility.v1',
+                    },
+                },
+                elements    => {
+                    application                     => {  min => 1, max => 1, order => 10,  },
+                },
+            },
+            application     =>  {
+                exclusive   => 'none',
+                content     => { elements => 1, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    xmlns           => {
+                        required    => 0,
+                        default     => 'urn:schemas-microsoft-com:asm.v3',
+                    },
+                },
+                elements    => {
+                    supportedOS                     => {  min => 0, max => 0, order => 10  },
+                    windowsSettings                 => {  min => 0, max => 0, order => 10  },
+                },
+            },
+            supportedOS     =>  {
+                exclusive   => 'none',
+                content     => { elements => 0, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    Id => {
+                        required    => 1,
+                        # Windows Vista Compatibility Key
+                        default     => '{e2011457-1546-43c5-a5fe-008deee3d3f0}',
+                        order => 1002,
+                    },
+                },
+                elements    => {
+                },
+            },
+            clrClass        =>  {
+                exclusive   => 'assembly',
+                content     => { elements => 1, attributes => 0, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    name => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1002,
+                    },
+                    clsid => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1003,
+                    },
+                    progid => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1004,
+                    },
+                    tlbid => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1005,
+                    },
+                    description => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1006,
+                    },
+                    runtimeVersion => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1007,
+                    },
+                    threadingModel => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1008,
+                    },                
+                },
+                elements    => {
+                    progid                     => {  min => 0, max => 0, order => 10  },
+                },
+            },
+            clrSurrogate        =>  {
+                exclusive   => 'assembly',
+                content     => { elements => 0, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    name => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1002,
+                    },
+                    clsid => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1003,
+                    },
+                    runtimeVersion => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1004,
+                    },
+                },
+                elements    => {
+                },
+            },
+            assemblyIdentity        =>  {
+                exclusive   => 'none',
+                content     => { elements => 0, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    name => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1003,
+                    },
+                    version => {
+                        required    => 0,
+                        default     => '0.0.0.0',
+                        order       => 1004,
+                    },
+                    type => {
+                        required    => 0,
+                        default     => 'win32',
+                        order       => 1002,
+                    },
+                    processorArchitecture => {
+                        required    => 0,
+                        default     => '*',
+                        order       => 1006,
+                    },
+                    publicKeyToken => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1007,
+                    },
+                    language => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1005,
+                    },
+                },
+                elements    => {
+                },
+            },
+            comInterfaceProxyStub        =>  {
+                exclusive   => 'assembly',
+                content     => { elements => 0, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    name => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1003,
+                    },
+                    iid => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1002,
+                    },
+                    tblid => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1004,
+                    },
+                    numMethods => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1006,
+                    },
+                    proxyStubClsid32 => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1007,
+                    },
+                    baseInterface => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1005,
+                    },
+                    threadingModel => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1008,
+                    },
+                },
+                elements    => {
+                },
+            },
+            description        =>  {
+                exclusive   => 'none',
+                content     => { elements => 0, attributes => 0, value => 1 },
+                value_validator => 'validate_string',
+                attributes  => {
+                },
+                elements    => {
+                },
+            },
+            dependency        =>  {
+                exclusive   => 'none',
+                content     => { elements => 1, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    optional => {
+                        required    => 0,
+                        default     => 'no',
+                        order       => 1002,
+                    },
+                },
+                elements    => {
+                    dependentAssembly       => {  min => 0, max => 1, order => 10  },                
+                }
+            },
+            dependentAssembly        =>  {
+                exclusive   => 'none',
+                content     => { elements => 1, attributes => 0, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                },            
+                elements    => {
+                    assemblyIdentity       => {  min => 1, max => 1, order => 10  },
+                    bindingRedirect        => {  min => 0, max => 0, order => 20  }, 
+                },
+            },
+            bindingRedirect        =>  {
+                exclusive   => 'application',
+                content     => { elements => 0, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    oldVersion => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1002,
+                    },
+                    newVersion => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1003,
+                    },                
+                },
+                elements    => {
+                },
+            },
+            file        =>  {
+                exclusive   => 'none',
+                content     => { elements => 1, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    name => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1002,
+                    },
+                    hash => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1004,
+                    },
+                    hashalg => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1003,
+                    },
+                    size => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1005,
+                    },
+                },
+                elements    => {
+                    comClass               => {  min => 0, max => 0, order => 10,  },
+                    comInterfaceProxyStub  => {  min => 0, max => 0, order => 20,  },
+                    typelib                => {  min => 0, max => 0, order => 30,  },
+                    windowClass            => {  min => 0, max => 0, order => 40,  },
+                },
+            },
+            comClass        =>  {
+                exclusive   => 'assembly',
+                content     => { elements => 1, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    clsid => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1003,
+                    },
+                    threadingModel => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1004,
+                    },
+                    progid => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1003,
+                    },
+                    tlbid => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1005,
+                    },
+                    description => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1002,
+                    },
+                    miscStatus => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1006,
+                    },
+                    miscStatusIcon => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1007,
+                    },
+                    miscStatusDocprint => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1008,
+                    },
+                    miscStatusContent => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1009,
+                    },
+                    musStatusThumbnail => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1010,
+                    },
+                },
+                elements    => {
+                    progid                 => {  min => 0, max => 0, order => 10,  },
+                },
+            },
+            comInterfaceExternalProxyStub        =>  {
+                exclusive   => 'assembly',
+                content     => { elements => 0, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    name => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1005,
+                    },
+                    iid => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1002,
+                    },
+                    tblid => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1006,
+                    },
+                    numMethods => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1004,
+                    },
+                    proxyStubClsid32 => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1007,
+                    },
+                    baseInterface => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1003,
+                    },
+                },
+                elements    => {
+                },
+            },
+            typelib        =>  {
+                exclusive   => 'assembly',
+                content     => { elements => 0, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    tblid => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1002,
+                    },
+                    version => {
+                        required    => 1,
+                        default     => undef,
+                        order       => 1003,
+                    },
+                    helpdir => {
+                        required    => 1,
+                        default     => '',
+                        order       => 1004,
+                    },
+                    resourceid => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1006,
+                    },
+                    flags => {
+                        required    => 0,
+                        default     => undef,
+                        order       => 1005,
+                    },
+                },
+                elements    => {
+                },
+            },
+            windowClass        =>  {
+                exclusive   => 'assembly',
+                content     => { elements => 0, attributes => 1, value => 1 },
+                value_validator => 'validate_class_name',
+                attributes  => {
+                    versioned => {
+                        required    => 1,
+                        default     => 'yes',
+                        order       => 1002,
+                    },
+                },
+                elements    => {
+                },
+            },
+            noInherit        =>  {
+                exclusive   => 'application',
+                content     => { elements => 0, attributes => 0, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                },
+                elements    => {
+                },
+            },
+            noInheritable        =>  {
+                exclusive   => 'assembly',
+                content     => { elements => 0, attributes => 0, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                },
+                elements    => {
+                },
+            },
+            progid        =>  {
+                exclusive   => 'assembly',
+                content     => { elements => 0, attributes => 0, value => 1 },
+                value_validator => 'validate_class_name',
+                attributes  => {
+                },
+                elements    => {
+                },
+            },
+            windowsSettings     =>  {
+                exclusive   => 'none',
+                content     => { elements => 1, attributes => 1, value => 0 },
+                value_validator => undef,
+                attributes  => {
+                    xmlns           => {
+                        required    => 1,
+                        default     => 'http://schemas.microsoft.com/SMI/2005/WindowsSettings',
+                    },
+                },
+                elements    => {
+                    dpiAware                        => {  min => 0, max => 1, order => 10  },
+                },
+            },
+            dpiAware       =>  {
+                exclusive   => 'none',
+                content     => { elements => 0, attributes => 0, value => 1 },
+                value_validator => 'validate_truefalse',
+                attributes  => {
+                },
+                elements    => {
+                },
+            },
+        },
+    };
+    return $schema;
+}
+
+1;
+
+__END__
+
+=head1 SEE ALSO
+
+Win32::Exe::Manifest
+
+=head1 AUTHORS
+
+Mark Dootson E<lt>mdootson@cpan.orgE<gt>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 by Mark Dootson E<lt>mdootson@cpan.orgE<gt>
+
+This program is free software; you can redistribute it and/or 
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+

database/perl/vendor/lib/Win32/Exe/PE.pm

@@ -0,0 +1,23 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/PE/Header.pm

@@ -0,0 +1,25 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/PE/Header/PE32.pm

@@ -0,0 +1,72 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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));
+}
+
+
+sub ExpectedOptHeaderSize { 224 };
+
+
+1;

database/perl/vendor/lib/Win32/Exe/PE/Header/PE32Plus.pm

@@ -0,0 +1,73 @@
+#--------------------------------------------------------------------
+# 64 bit PE+ header as per 'Microsoft PE and COFF Specification' from
+# http://www.microsoft.com/whdc/system/platform/firmware/PECOFF.mspx
+#--------------------------------------------------------------------
+
+package Win32::Exe::PE::Header::PE32Plus;
+use strict;
+use base 'Win32::Exe::PE::Header';
+
+use constant SUBFORMAT => (
+    ImageBase       => 'a8',
+    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    => 'a8',
+    StackCommit     => 'a8',
+    HeapReserve     => 'a8',
+    HeapCommit      => 'a8',
+    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));
+}
+
+sub ExpectedOptHeaderSize { 240 };
+    
+
+1;

database/perl/vendor/lib/Win32/Exe/Resource.pm

@@ -0,0 +1,37 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/Resource/GroupIcon.pm

@@ -0,0 +1,69 @@
+# Copyright 2004, 2010 by Audrey Tang <cpan@audreyt.org>
+
+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;
+	
+	# get the existing resource icon ids
+	
+	my %existids = ();
+	for my $groupicon ($rsrc->objects('GroupIcon')) {	
+		for my $icon ( $groupicon->icons ) {
+			my $id = $icon->Id;
+			$existids{$id} = 1;
+		}
+    }
+
+	my $nextid = 0;
+    foreach my $idx (0 .. $#{$icons}) {
+		$nextid ++;
+		while(exists($existids{$nextid})) { $nextid ++; }
+		my $icon = $self->icons->[$idx];
+		$icon->SetId($nextid);
+		$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;

database/perl/vendor/lib/Win32/Exe/Resource/Icon.pm

@@ -0,0 +1,53 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/Resource/Manifest.pm

@@ -0,0 +1,70 @@
+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 get_manifest_id {
+    my $self = shift;
+    my ($type, $id, @rest);
+    eval{ ($type, $id, @rest) = $self->path; };
+    $id or return 1;
+    $id =~ s/^#//;
+    return( $id =~ /^(1|2|3)$/) ? $id : 1;
+}
+
+sub set_manifest {
+    my ( $self, $xmltext, $mid ) = @_;
+    $mid ||= 1;
+    $mid = ( $mid =~ /^(1|2|3)$/ ) ? $mid : 1; 
+    $self->SetData( $self->encode_manifest($xmltext) );
+    my $rsrc = $self->first_parent('Resources');
+    $rsrc->remove("/#RT_MANIFEST");
+    $rsrc->insert('/#RT_MANIFEST/#' . $mid . '/#0' => $self);
+    $rsrc->refresh;
+}
+
+sub update_manifest {
+    my ( $self, $xmltext ) = @_;
+    $self->SetData( $self->encode_manifest($xmltext) );
+}
+
+sub encode_manifest {
+    my ($self, $string) = @_;
+    use bytes;
+    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 type="win32" version="0.0.0.0" name="Perl.Win32.Application" />
+    <description>Perl.Win32.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="*" />
+        </dependentAssembly>
+    </dependency>
+</assembly>
+W32EXEDEFAULTMANIFEST
+;
+    return $defman;
+}
+
+1;

database/perl/vendor/lib/Win32/Exe/Resource/Version.pm

@@ -0,0 +1,363 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/ResourceData.pm

@@ -0,0 +1,57 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/ResourceEntry.pm

@@ -0,0 +1,68 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/ResourceEntry/Id.pm

@@ -0,0 +1,46 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/ResourceEntry/Name.pm

@@ -0,0 +1,41 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/ResourceTable.pm

@@ -0,0 +1,34 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;

database/perl/vendor/lib/Win32/Exe/Section.pm

@@ -0,0 +1,156 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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 && ( $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;
+    my $act_headersize = $exe->OptHeaderSize;
+    my $exp_headersize = $exe->ExpectedOptHeaderSize;
+    
+    ($act_headersize && ( $act_headersize == $exp_headersize )) or die "Unsupported binary format: headersize $act_headersize ne $exp_headersize";
+    
+    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;

database/perl/vendor/lib/Win32/Exe/Section/Code.pm

@@ -0,0 +1,8 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+package Win32::Exe::Section::Code;
+
+use strict;
+use base 'Win32::Exe::Section';
+
+1;

database/perl/vendor/lib/Win32/Exe/Section/Data.pm

@@ -0,0 +1,8 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+package Win32::Exe::Section::Data;
+
+use strict;
+use base 'Win32::Exe::Section';
+
+1;

database/perl/vendor/lib/Win32/Exe/Section/Debug.pm

@@ -0,0 +1,8 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+package Win32::Exe::Section::Debug;
+
+use strict;
+use base 'Win32::Exe::Section';
+
+1;

database/perl/vendor/lib/Win32/Exe/Section/Exports.pm

@@ -0,0 +1,8 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+package Win32::Exe::Section::Exports;
+
+use strict;
+use base 'Win32::Exe::Section';
+
+1;

database/perl/vendor/lib/Win32/Exe/Section/Imports.pm

@@ -0,0 +1,8 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+package Win32::Exe::Section::Imports;
+
+use strict;
+use base 'Win32::Exe::Section';
+
+1;

database/perl/vendor/lib/Win32/Exe/Section/Resources.pm

@@ -0,0 +1,259 @@
+# Copyright 2004 by Audrey Tang <cpan@audreyt.org>
+
+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;