view release on metacpan or  search on metacpan

lib/Alien/Build/Plugin/Probe/GnuWin32.pm  view on Meta::CPAN

package Alien::Build::Plugin::Probe::GnuWin32;

use strict;
use warnings;
use Alien::Build::Plugin;
use Module::Load ();
use File::Spec;
use Carp ();
use Capture::Tiny qw( capture );
use List::Util ();

# ABSTRACT: Probe for GnuWin32 packages using the Windows registry
our $VERSION = '0.59'; # VERSION


has native_only         => 0;
has registery_key_regex => undef;
has registry_key_regex  => undef;
has exe_name            => undef;
has exe_match           => undef;
has exe_version         => undef;
has exe_args            => ['--version'];

sub _short ($)
{
  $_[0] =~ /\s+/ ? Win32::GetShortPathName( $_[0] ) : $_[0];
}

sub new
{
  my $class = shift;
  
  my $self = $class->SUPER::new(@_);
  
  if($self->registery_key_regex)
  {
    require Alien::Build;
    Alien::Build->log("warning: you are using a typo'd property, 'registery_key_regex', please use 'registry_key_regex' instead");
  }
  
  $self->registry_key_regex || $self->registry_key_regex($self->registery_key_regex) || Carp::croak "register_key_regex is required";
  
  $self;  
}

sub init
{
  my($self, $meta) = @_;
  
  # we may decide to take this module out of core.
  $meta->add_requires( 'configure' => 'Alien::Build::Plugin::Probe::GnuWin32' => 0 );
  
  if($^O eq 'MSWin32')
  {
    $meta->register_hook(
      probe => sub {
        my($build) = @_;
        
        my @paths = ([]);
        
        if(eval { Module::Load::load "Win32API::Registry"; 1 })
        {
          my @uninstall_key_names = qw(
            software\microsoft\windows\currentversion\uninstall
          );
          unshift @uninstall_key_names, qw( software\wow6432node\microsoft\windows\currentversion\uninstall )
            unless $self->native_only;
          
          foreach my $uninstall_key_name (@uninstall_key_names)
          {
            my $uninstall_key;
            Win32API::Registry::RegOpenKeyEx(
              Win32API::Registry::HKEY_LOCAL_MACHINE(),
              $uninstall_key_name,
              0,
              Win32API::Registry::KEY_READ(), 
              $uninstall_key ) || next;
            
            my $pos = 0;
            my($subkey, $class, $time) = ('','','');
            my($namSiz, $clsSiz) = (1024,1024);
            while(Win32API::Registry::RegEnumKeyEx( $uninstall_key, $pos++, $subkey, $namSiz, [], $class, $clsSiz, $time))
            {
              next unless $subkey =~ $self->registery_key_regex;
              my $flex_key;
              Win32API::Registry::RegOpenKeyEx( 
                $uninstall_key, 
                $subkey, 
                0, 
                Win32API::Registry::KEY_READ(),
                $flex_key ) || next;
              
              my $data;