#!/usr/bin/perl -w
#
#  Automatically add '.PL' to the Windows PATHEXT variable so one
#  can invoke Perl scripts *without* typing the .pl extension.
#
#  NOTE -- Explorer needs to be reloaded for the changes to take
#  effect; hence the call to reload_explorer().  Even so, changes
#  still only apply to *new* command windows.
#
#  Many thanks to Tye -- he not only provided the code for the
#  subroutine reload_explorer(), he's also the author of the
#  Win32::TieRegistry module which this script depends on.
##


###############
## Libraries ##
###############
use strict;
use warnings;
use File::Basename;
use Win32::API;
use Win32::TieRegistry( Delimiter => '/' );


##################
## Main Program ##
##################
my $h_sys = $Registry->{"LMachine/SYSTEM"};
my @sets  = keys %$h_sys;

foreach my $set (@sets) {
    my $h_set   = $h_sys->{$set};
    my $h_env   = $h_set->{"Control/Session Manager/Environment"};
    my $pathext = $h_env->{'PATHEXT'};
    if ($pathext || "") {
        $h_env->{'PATHEXT'} = add_pathext($pathext, '.PL');
        print "[$set]\n";
        print "Before:  $pathext\n";
        print " After:  $h_env->{PATHEXT}\n\n";
    }
}

reload_explorer();


#################
## Subroutines ##
#################
sub add_pathext {
    my ($pathext, $ext) = @_;
    my $a_paths  = [ split(';', $pathext) ];
    my $b_exists = 0;
    my $a_modify = [ ];

    foreach my $path (@$a_paths) {
        ($path eq $ext) and $b_exists = 1;
        push @$a_modify, $path;
    }

    $b_exists or push @$a_modify, $ext;
    return join ';', @$a_modify;
}


sub reload_explorer {
    use constant HWND_BROADCAST     => 0xffff;
    use constant WM_SETTINGCHANGE   => 0x001A;
    use constant SMTO_ABORTIFHUNG   => 2;

    my $send = Win32::API->new(
        'user32', 'SendMessageTimeout', 'LLLPLLL', 'L',
    ) or  die "Can't load SendMessageTimeout(): $^E\n";

    $send->Call(
        HWND_BROADCAST(), WM_SETTINGCHANGE(), 0,
        "Environment", SMTO_ABORTIFHUNG(), 5000, 0,
    );
}