The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
package Padre::Plugin::Moose::Class;

use Moose;

our $VERSION = '0.21';

with 'Padre::Plugin::Moose::Role::CanGenerateCode';
with 'Padre::Plugin::Moose::Role::HasClassMembers';
with 'Padre::Plugin::Moose::Role::CanProvideHelp';
with 'Padre::Plugin::Moose::Role::CanHandleInspector';

has 'name'         => ( is => 'rw', isa => 'Str', default => '' );
has 'superclasses' => ( is => 'rw', isa => 'Str', default => '' );
has 'roles'        => ( is => 'rw', isa => 'Str', default => '' );
has 'immutable'    => ( is => 'rw', isa => 'Bool' );
has 'namespace_autoclean' => ( is => 'rw', isa => 'Bool' );
has 'singleton'           => ( is => 'rw', isa => 'Bool' );

sub generate_moose_code {
	my $self                = shift;
	my $options             = shift;
	my $comments            = $options->{comments};
	my $namespace_autoclean = $options->{namespace_autoclean};
	my $class               = $self->name;
	my $superclasses        = $self->superclasses;
	my $roles               = $self->roles;
	my $make_immutable      = $self->immutable;

	$class        =~ s/^\s+|\s+$//g;
	$superclasses =~ s/^\s+|\s+$//g;
	$roles        =~ s/^\s+|\s+$//g;
	my @roles = split /,/, $roles;

	my $code = "package $class;\n";

	$code .= "\nuse Moose;";

	$code .=
		$comments
		? " # automatically turns on strict and warnings\n"
		: "\n";

	if ($namespace_autoclean) {
		$code .= "use namespace::clean;";
		$code .=
			$comments
			? " # Keep imports out of your namespace\n"
			: "\n";
	}

	# If there is at least one subtype, we need to add this import
	if ( scalar @{ $self->subtypes } ) {
		$code .= "use Moose::Util::TypeConstraints;\n";
	}

	# Singleton via MooseX::Singleton
	$code .= "use MooseX::Singleton;\n" if $self->singleton;

	# Class attributes via MooseX::ClassAttribute
	for my $attribute ( @{ $self->attributes } ) {
		if ( $attribute->class_has ) {
			$code .= "use MooseX::ClassAttribute;\n" if $attribute->class_has;
			last;
		}
	}

	$code .= "\nextends '$superclasses';\n" if $superclasses ne '';

	$code .= "\n" if scalar @roles;
	for my $role (@roles) {
		$code .= "with '$role';\n";
	}

	# Generate class members
	$code .= $self->to_class_members_code($options);

	if ($make_immutable) {
		$code .= "\n__PACKAGE__->meta->make_immutable;";
		$code .=
			$comments
			? " # Makes it faster at the cost of startup time\n"
			: "\n";
	}

	if ($namespace_autoclean) {
		$code .= "\n1;\n\n";
	} else {
		if ( scalar @{ $self->subtypes } ) {
			$code .= "\nno Moose::Util::TypeConstraints;\n";
		}
		$code .= "\nno Moose;\n1;\n\n";
	}

	return $code;
}

# Generate Mouse code!
sub generate_mouse_code {
	my $self                = shift;
	my $options             = shift;
	my $comments            = $options->{comments};
	my $namespace_autoclean = $options->{namespace_autoclean};
	my $class               = $self->name;
	my $superclasses        = $self->superclasses;
	my $roles               = $self->roles;
	my $make_immutable      = $self->immutable;

	$class        =~ s/^\s+|\s+$//g;
	$superclasses =~ s/^\s+|\s+$//g;
	$roles        =~ s/^\s+|\s+$//g;
	my @roles = split /,/, $roles;

	my $code = "package $class;\n";

	$code .= "\nuse Mouse;";

	$code .=
		$comments
		? " # automatically turns on strict and warnings\n"
		: "\n";

	if ($namespace_autoclean) {
		$code .= "use namespace::clean;";
		$code .=
			$comments
			? " # Keep imports out of your namespace\n"
			: "\n";
	}

	# If there is at least one subtype, we need to add this import
	if ( scalar @{ $self->subtypes } ) {
		$code .= "use Mouse::Util::TypeConstraints;\n";
	}

	$code .= "\nextends '$superclasses';\n" if $superclasses ne '';

	$code .= "\n" if scalar @roles;
	for my $role (@roles) {
		$code .= "with '$role';\n";
	}

	# Generate class members
	$code .= $self->to_class_members_code($options);

	if ($make_immutable) {
		$code .= "\n__PACKAGE__->meta->make_immutable;";
		$code .=
			$comments
			? " # Makes it faster at the cost of startup time\n"
			: "\n";
	}

	if ($namespace_autoclean) {
		$code .= "\n1;\n\n";
	} else {
		if ( scalar @{ $self->subtypes } ) {
			$code .= "\nno Mouse::Util::TypeConstraints;\n";
		}
		$code .= "\nno Mouse;\n1;\n\n";
	}

	return $code;
}

sub generate_moosex_declare_code {
	my $self           = shift;
	my $options        = shift;
	my $comments       = $options->{comments};
	my $class          = $self->name;
	my $superclasses   = $self->superclasses;
	my $roles          = $self->roles;
	my $make_immutable = $self->immutable;

	$class        =~ s/^\s+|\s+$//g;
	$superclasses =~ s/^\s+|\s+$//g;
	$roles        =~ s/^\s+|\s+$//g;
	my @roles = split /,/, $roles;

	my $class_body = '';

	# If there is at least one subtype, we need to add this import
	if ( scalar @{ $self->subtypes } ) {
		$class_body .= "use Moose::Util::TypeConstraints;\n";
	}

	# Generate class members
	$class_body .= $self->to_class_members_code($options);

	my @lines = split /\n/, $class_body;
	for my $line (@lines) {
		$line = "\t$line" if $line ne '';
	}
	$class_body = join "\n", @lines;

	my $extends = ( $superclasses ne '' ) ? "extends ($superclasses) " : q{};
	my $with    = ( scalar @roles )       ? "with ($roles) "           : q{};
	my $mutable = $make_immutable         ? q{}                        : "is mutable ";

	# namespace::autoclean is implicit in { }
	return "use MooseX::Declare;\nclass $class $extends$with$mutable\{\n$class_body\n}\n";
}

sub provide_help {
	require Wx;
	return Wx::gettext(
		' A class is a blueprint of how to create objects of itself. A class can contain attributes, subtypes and methods which enable objects to have state and behavior.'
	);
}

sub read_from_inspector {
	my $self = shift;
	my $grid = shift;

	my $row = 0;
	for my $field (qw(name superclasses roles immutable singleton)) {
		$self->$field( $grid->GetCellValue( $row++, 1 ) );
	}
}

sub write_to_inspector {
	my $self = shift;
	my $grid = shift;

	my $row = 0;
	for my $field (qw(name superclasses roles immutable singleton)) {
		$grid->SetCellValue( $row++, 1, $self->$field );
	}
}

sub get_grid_data {
	require Wx;
	return [
		{ name => Wx::gettext('Name:') },
		{ name => Wx::gettext('Superclasses:') },
		{ name => Wx::gettext('Roles:') },
		{ name => Wx::gettext('Make immutable?'), is_bool => 1 },
		{ name => Wx::gettext('Singleton?'), is_bool => 1 },
	];
}

__PACKAGE__->meta->make_immutable;

no Moose;
1;