Perl::Dist::WiX::Asset::Launcher - Start menu launcher asset for a Win32 Perl

  my $batlauncher = Perl::Dist::WiX::Asset::Launcher->new(
    parent => $dist,
    name   => 'CPAN Client',
    bin    => 'cpan',
  );

  $batlauncher->install();

  my $exelauncher = Perl::Dist::WiX::Asset::Launcher->new(
    parent => $dist,
    name   => 'Padre Development Environment',
    bin    => 'padre',
    exe    => 1,
  );

  $exelauncher->install();

package Perl::Dist::WiX::Asset::Launcher;

use 5.010;
use Moose;
use MooseX::Types::Moose qw( Str Bool );
use File::Spec::Functions qw( catfile );
use Perl::Dist::WiX::Exceptions;

our $VERSION = '1.500';
$VERSION =~ s/_//ms;

with 'Perl::Dist::WiX::Role::NonURLAsset';

has name => (
	is       => 'bare',
	isa      => Str,
	reader   => 'get_name',
	required => 1,
);

has bin => (
	is       => 'bare',
	isa      => Str,
	reader   => '_get_bin',
	required => 1,
);

has exe => (
	is      => 'bare',
	isa     => Bool,
	reader  => '_get_exe',
	default => 0,
);

has directory_id => (
	is      => 'bare',
	isa     => Str,
	reader  => '_get_directory_id',
	default => 'D_App_Menu_Tools',
);

sub install {
	my $self = shift;

	my $bin = $self->_get_bin();
	my $ext = $self->_get_exe() ? '.exe' : '.bat';

	# Check the script exists
	my $to = catfile( $self->_get_image_dir(), 'perl', 'bin', "$bin$ext" );
	if ( not -f $to ) {
		PDWiX::File->throw(
			file    => $to,
			message => 'File does not exist'
		);
	}

	my $icons     = $self->_get_icons();
	my $icon_type = ref $icons;
	$icon_type ||= '(undefined type)';
	if ( 'Perl::Dist::WiX::IconArray' ne $icon_type ) {
		PDWiX->throw( "Icons array is of type $icon_type, "
			  . 'not a Perl::Dist::WiX::IconArray' );
	}

	my $icon_id =
	  $self->_get_icons()
	  ->add_icon( $self->_get_icon_file($bin), "$bin$ext" );

	# Add the icon.
	$self->_add_icon(
		name         => $self->get_name(),
		filename     => $to,
		fragment     => 'StartMenuIcons',
		icon_id      => $icon_id,
		directory_id => $self->_get_directory_id(),
	);

	return 1;
} ## end sub install

sub _get_icon_file {
	my $self = shift;
	my $name = shift;

	my ( $dir, $file );

	# Start with the parent reference contained in this asset.
	my $class = ref $self->_get_parent();

	no strict 'refs'; ## no critic(ProhibitNoStrict)
	while ( defined $class and $class ne 'Moose::Object' ) {

		# Get the directory of this class's dist_dir and check for the icon.
		$dir = $class->dist_dir();
		$file = catfile( $dir, "$name.ico" );
		if ( -f $file ) {
			return $file;
		}

		# Pick up the first parent of the class, and try again.
		$class = ${"${class}::ISA"}[0];
	} ## end while ( defined $class and...)

	PDWiX::File->throw(
		message => 'File not found.',
		file    => "$name.ico"
	);

	return;

} ## end sub _get_icon_file

no Moose;
__PACKAGE__->meta->make_immutable;

1;

__END__