package Padre::Plugin::FormBuilder::PerlX;

=pod

=head1 NAME

Padre::Plugin::FormBuilder::Perl - wxFormBuilder to Padre dialog code generator

=head1 SYNOPSIS

  my $generator = Padre::Plugin::FormBuilder::Perl->new(
      dialog => $fbp_object->dialog('MyDialog')
  );

=head1 DESCRIPTION

This is a L<Padre>-specific variant of L<FBP::Perl>.

It overloads various methods to make things work in a more Padre-specific way.

=cut

use 5.008005;
use strict;
use warnings;
use Scalar::Util ();
use FBP::Perl 0.38 ();
use Mouse 0.61;

our $VERSION = '0.02';

extends 'FBP::Perl';

has version => (
	is       => 'ro',
	isa      => 'Str',
	required => 1,
	default  => '0.01',
);

has encapsulate => (
	is       => 'ro',
	isa      => 'Bool',
	required => 1,
	default  => 0,
);

######################################################################
# Dialog Generators

sub dialog_class {
	my $self    = shift;
	my $name    = shift;
	my $package = shift;
	my $code    = $self->SUPER::dialog_class($name);

	# Customise the package name if requested
	if ($package) {
		splice( @$code, 0, 1, "package $package;" );
	}

	# Prepend an auto-generated "Don't Modify" warning
	my $class = Scalar::Util::blessed($self);
	splice(
		@$code,
		1,
		0,
		"",
		"# This module was generated by $class.",
		"# To change this module, edit the original .fbp file and regenerate.",
		"# DO NOT MODIFY BY HAND!",
	);

	# Append the copywrite statement that Debian/etc need
	push @$code, <<'END_PERL';
=pod

=over 4

=item new ()

Constructor. Auto-generated by Padre::Plugin::FormBuilder.

=back

=head1 AUTHOR

Adam Kennedy E<lt>adamk@cpan.orgE<gt>

=head1 SEE ALSO

L<Padre>

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2008-2011 The Padre development team as listed in Padre.pm.

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

=cut

END_PERL

	return $code;
}

sub dialog_new {
	my $self   = shift;
	my $dialog = shift;
	my $lines  = $self->SUPER::dialog_new($dialog);

	# Find the full list of public windows
	my @public = grep { $_->permission eq 'public' } $dialog->find( isa => 'FBP::Window' );

	if ( $self->encapsulate and @public ) {

		# Generate code to save the wxWidgets id values to the hash slots
		my @save = ('');
		foreach my $window (@public) {
			my $name     = $window->name;
			my $variable = $self->object_variable($window);
			push @save, "\t\$self->{$name} = $variable->GetId;";
		}

		# Splice the bind code into the constructor
		splice( @$lines, $#$lines - 2, 0, @save );
	}

	return $lines;
}

sub use_pragma {
	my $self   = shift;
	my $dialog = shift;
	return [
		"use 5.010;",
		"use strict;",
		"use warnings;",
		"use diagnostics;",
		"use utf8;",
		"use autodie;",
	]
}

sub dialog_version {
	my $self    = shift;
	my $dialog  = shift;
	my $version = $self->version;
	
	# use version; our $VERSION = qv(0.04);
	return [ "use version; our \$VERSION = qv($version);", ];
}

sub use_wx {
	my $self   = shift;
	my $dialog = shift;
	return [ "use Padre::Wx ();", "use Padre::Wx::Role::Main ();", ];
}

sub dialog_isa {
	my $self   = shift;
	my $dialog = shift;

	return $self->nested(
		"use parent -norequire, qw(", "Padre::Wx::Role::Main",
		"Wx::Dialog", ");",
	);
}

sub window_accessor {
	my $self = shift;
	unless ( $self->encapsulate ) {
		return $self->SUPER::window_accessor(@_);
	}

	my $object = shift;
	my $name   = $object->name;
	my $space  = q{ };

	my @tmp_pod = [
		"=pod",
		"$space",
		"=over 4",
		"$space",
		"=item $name ()",
		"$space",
		"Public Accessor $name Auto-generated.",
		"$space",
		"=back",
		"$space",
		"=cut",
	];

	my @tmp_accessor_method = $self->nested(
		"sub $name {",
		"my \$self = shift;",
		"return Wx::Window::FindWindowById(\$self->{$name});",
		"}",
	);

	my @conjoined = ( @tmp_pod, @tmp_accessor_method );
	return @conjoined;
}

sub window_event {
	my $self   = shift;
	my $window = shift;
	my $event  = shift;
	my $name   = $window->name;
	my $method = $window->$event();
	my $space  = q{ };

	my @tmp_pod = [
		"=pod",
		"$space",
		"=over 4",
		"$space",
		"=item $method ()",
		"$space",
		"Event Handler for $name.$event (Required). Auto-generated.",
		"You must implement this Method in your calling class.",
		"$space",
		"=back",
		"$space",
		"=cut",
	];

	my @tmp_required_method = $self->nested(
		"sub $method {",
		"my \$self = shift;",
		"return \$self->main->error('Handler method $method for event $name.$event not implemented');",
		"}",
	);

	my @conjoined = ( @tmp_pod, @tmp_required_method );
	return @conjoined;
}

# Because we expect everything to be shimmed, apply a stricter interpretation
# of lexicality if the code is being generated for Padre.
sub object_lexical {
	my $self = shift;
	unless ( $self->encapsulate ) {
		return $self->SUPER::object_lexical(@_);
	}
	return 1;
}

1;

=pod

=head1 SUPPORT

Bugs should be reported via the CPAN bug tracker at

L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Padre-Plugin-FormBuilder>

For other issues, or commercial enhancement or support, contact the author.

=head1 AUTHOR

Adam Kennedy E<lt>adamk@cpan.orgE<gt>

=head1 SEE ALSO

L<Padre>

=head1 COPYRIGHT

Copyright 2010 Adam Kennedy.

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

The full text of the license can be found in the
LICENSE file included with this module.

=cut