@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
%~dp0perl\bin\perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
%~dp0perl\bin\perl -x -S %0 %*
goto endofperl
@rem ';
#!perl

use 5.010;
use strict;
use warnings;
use Win32::TieRegistry qw(:KEY_);
use File::Spec::Functions qw(catdir splitpath);
use English qw(-no_match_vars);
use Carp qw(carp);
use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
use FindBin;
use Win32::API;
use Config;

### global variables

my $directory;
my $quiet = 0;
my $system = 1;

### main

GetOptions('help'        => sub { pod2usage(-exitstatus => 0, -verbose => 2); },
           'directory=s' => \$directory,
           'quiet'       => \$quiet,
           'system!'     => \$system,
          ) or pod2usage(-verbose => 2);

if (not defined $directory) {
    $directory = $FindBin::Bin;
    $directory =~ s{/}{\\}g;
}

if (not defined $directory) {
    carp q{Could not get the script's directory, and no --directory option was given};
}

# Get the appropriate environment entries.
my ($hklm_env, $hklm_env_ro, $hkcu_env);
if ($system) {
    $hklm_env = Win32::TieRegistry->new(
        'HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Session Manager/Environment',
        {
            Access => KEY_READ() | KEY_WRITE() | 256,
            Delimiter => '/',
        }
    ); # returns undef if SYSTEM ENV not writable
}

$hklm_env_ro = Win32::TieRegistry->new(
    'HKEY_LOCAL_MACHINE/SYSTEM/CurrentControlSet/Control/Session Manager/Environment',
    {
        Access => KEY_READ() | 256,
        Delimiter => '/',
    }
); # read only SYSTEM ENV - for checking existing PATH items

$hkcu_env = Win32::TieRegistry->new(
    'HKEY_CURRENT_USER/Environment',
    {
        Access => KEY_READ() | KEY_WRITE() | 256,
        Delimiter => '/',
    }
);

# If system environment is not writable (or not requested) try the user environment.
my ($env, $location);
if (defined($hklm_env)) {
    $env = $hklm_env;
    $location = 'system';
} else {
    $env = $hkcu_env;
    $location = 'user';
}

my @existing_path_items;
push(@existing_path_items, split(/;/,$hklm_env_ro->GetValue('Path'))) if $hklm_env_ro;
push(@existing_path_items, split(/;/,$hkcu_env->GetValue('Path'))) if $hkcu_env;
for (@existing_path_items) { $_ =~ s/[\\]*$// }; #remove trailing backslahes

my @items_to_add = map { catdir($directory, $_); } qw{c\bin perl\site\bin perl\bin};
my $changed = 0;

if (defined $env) {
    my $path = $env->GetValue('Path');
    foreach my $i (@items_to_add) {
        my @found = grep(/^\Q$i\E$/i, @existing_path_items);
        if (scalar(@found) == 0) {
          $path = "$path;$i";
          say "Adding $i to the $location path." unless $quiet;
          $changed = 1;
        }
    }
    $env->SetValue('Path', $path, 'REG_EXPAND_SZ') if $changed;
    if( !defined($env->GetValue('TERM')) || $env->GetValue('TERM') ne 'dumb') {
      $env->SetValue('TERM', 'dumb');
      say "Adding TERM=dumb to the $location environment." unless $quiet;
      $changed = 1;
    }
}
else {
    if ($system) {
        carp "Cannot open either the system or the user environment registry entries for read and write access";
    } else {
        carp "Cannot open the user environment registry entries for read and write access";
    }
}

if ($changed) {
  #gonna send WM_SETTINGCHANGE broadcast - to avoid the need for logout/login
  my $HWND_BROADCAST   = 0xFFFF;
  my $WM_SETTINGCHANGE = 0x001A;
  my $SMTO_ABORTIFHUNG = 0x0002;
  my $null = pack('xxxxxxxx'); # 8 x zero byte

  my $SendMessageTimeout = Win32::API->new("user32", "SendMessageTimeout", 'NNNPNNP', 'N') or die "Can't import SendMessageTimeout: $!\n";
  $SendMessageTimeout->Call($HWND_BROADCAST,$WM_SETTINGCHANGE,0,'Environment',$SMTO_ABORTIFHUNG,5000,$null);
}

__END__

=head1 DESCRIPTION

update_env.pl.bat - Updates the environment to add Strawberry Perl to the PATH
permanently, and adds other environment variables that portions of
Strawberry Perl uses.

=head1 SYNOPSIS

 update_path.pl.bat [ --help ] [--directory path] [--[no]system] [--quiet]

 Options:
   --help          Gives aid and comfort.
   --directory     The location the script is in. (used to set the path
                   to update to.) Defaults to $FindBin::Bin.
   --[no]system    Specifies whether to attempt to update the system
                   environment first. Defaults to --system.
   --quiet         Print nothing.

=head1 AUTHOR

Curtis Jewell E<lt>csjewell@cpan.orgE<gt>, KMX E<lt>kmx@cpan.orgE<gt>

=head1 COPYRIGHT & LICENSE

Copyright 2010 Curtis Jewell

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

=cut

:endofperl