Padre::Plugin::Perl6::QuickFix - Padre Perl 6 Quick Fix Provider

Padre-Plugin-Perl6 documentation Contained in the Padre-Plugin-Perl6 distribution.

Index

Code Index:

NAME

Top

Padre::Plugin::Perl6::QuickFix - Padre Perl 6 Quick Fix Provider

VERSION

Top

version 0.71

DESCRIPTION

Top

Perl 6 quick fixes are implemented here

AUTHORS

Top

COPYRIGHT AND LICENSE

Top

This software is copyright (c) 2010 by Ahmad M. Zawawi.

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

Padre-Plugin-Perl6 documentation Contained in the Padre-Plugin-Perl6 distribution. 
package Padre::Plugin::Perl6::QuickFix;
BEGIN {
  $Padre::Plugin::Perl6::QuickFix::VERSION = '0.71';
}

# ABSTRACT: Padre Perl 6 Quick Fix Provider
use 5.008;
use strict;
use warnings;

use Padre::Wx                  ();
use Padre::Plugin::Perl6::Util ();
use Padre::QuickFix            ();

our @ISA = ('Padre::QuickFix');

#
# Constructor.
# No need to override this
#
sub new {
	my ($class) = @_;

	# Create myself :)
	my $self = bless {}, $class;

	return $self;
}

#
# Tries to find quick fixes for errors in the current line
#
sub quick_fix_list {
	my ( $self, $doc, $editor ) = @_;

	if ( not defined $doc->{issues} ) {
		$doc->{issues} = [];
	}

	my $nl              = Padre::Plugin::Perl6::Util::guess_newline( $editor->GetText );
	my $current_line_no = $editor->GetCurrentLine;

	my @items      = ();
	my $num_issues = scalar @{ $doc->{issues} };
	foreach my $issue ( @{ $doc->{issues} } ) {
		my $issue_line_no = $issue->{line} - 1;
		if ( $issue_line_no == $current_line_no ) {
			my $issue_msg = $issue->{msg};
			$issue_msg =~ s/^\s+|\s+$//g;
			if ( $issue_msg =~ /^Variable\s+(.+?)\s+is not predeclared at/i ) {

				my $var_name = $1;

				# Fixes the following:
				# 	$foo = 1;
				# into:
				# 	my $foo;
				#	$foo = 1;
				push @items, {
					text     => sprintf( Wx::gettext('Insert declaration for %s'), $var_name ),
					listener => sub {

						#Insert a variable declaration before the start of the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						my $indent     = ( $line_text =~ /(^\s+)/ ) ? $1 : '';
						$line_text = "${indent}my $var_name;$nl" . $line_text;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Undeclared routine:\s+(.+?)\s+used/i ) {

				my $routine_name = $1;

				#flow control keywords
				my @flow_control_keywords = (
					'for',    'given', 'if',   'loop', 'repeat',
					'unless', 'until', 'when', 'while',
				);
				foreach my $keyword (@flow_control_keywords) {
					if ( $keyword eq $routine_name ) {

						# Fixes the following:
						# 	if() { };
						# into:
						# 	if () { };
						push @items, {
							text     => sprintf( Wx::gettext('Insert a space after %s'), $keyword ),
							listener => sub {

								#Insert a space before brace
								my $line_start = $editor->PositionFromLine($current_line_no);
								my $line_end   = $editor->GetLineEndPosition($current_line_no);
								my $line_text  = $editor->GetTextRange( $line_start, $line_end );
								$line_text =~ s/$keyword\(/$keyword \(/;
								$editor->SetSelection( $line_start, $line_end );
								$editor->ReplaceSelection($line_text);
							},
						};

						last;
					}
				}

				# Fixes the following:
				# 	foo();
				# into:
				# 	sub foo() {
				#		#XXX-implement
				# 	}
				# 	foo();
				push @items, {
					text     => sprintf( Wx::gettext('Insert routine %s'), $routine_name ),
					listener => sub {

						#Insert an empty routine definition before the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						my $indent     = ( $line_text =~ /(^\s+)/ ) ? $1 : '';
						$line_text =
							  "${indent}sub $routine_name {$nl"
							. "${indent}\t#XXX-implement$nl"
							. "${indent}}$nl"
							. $line_text;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of . to concatenate strings/i ) {

				# Fixes the following:
				# 	$string = "a" . "b";
				# into:
				# 	$string = "a" ~ "b";
				push @items, {
					text     => Wx::gettext('Use ~ instead of . for string concatenation'),
					listener => sub {

						#replace first '.' with '~' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\./~/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of -> to call a method/i ) {

				# Fixes the following:
				# 	P->foo;
				# into:
				# 	P.foo;
				push @items, {
					text     => Wx::gettext('Use . for method call'),
					listener => sub {

						#Replace first '->' with '.' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\-\>/\./;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of C\+\+ constructor syntax/i ) {

				# Fixes the following:
				# 	new Foo;
				# into:
				# 	Foo.new;
				push @items, {
					text     => Wx::gettext('Use Perl 6 constructor syntax'),
					listener => sub {

						#Replace first 'new Foo' with 'Foo.new' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );

						#new Point/new Point::Bar/new Point-In-Box
						$line_text =~ s/new\s+([\w\-\:\:]+)?/$1.new/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of C-style "for \(;;\)" loop/i ) {

				# Fixes the following:
				# 	for(;;) { };
				# into:
				# 	loop(;;) { };
				push @items, {
					text     => Wx::gettext('Use loop (;;) for looping'),
					listener => sub {

						#Replace first 'for (;;)' with 'loop (;;)' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/for\s+\(/loop (/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of \[-1\] subscript to access final element/i ) {

				# Fixes the following:
				# 	[-1];
				# into:
				# 	[*-1];
				push @items, {
					text     => Wx::gettext('Use [*-1] to access final element'),
					listener => sub {

						#Replace first '[-1]' with '[*-1]' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\[\s*-1\s*\]/[*-1]/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of rand\(N\)/i ) {

				# Fixes the following:
				# 	rand(10);
				# into:
				# 	10.pick;
				push @items, {
					text     => Wx::gettext('Use N.pick for a random number'),
					listener => sub {

						#Replace rand(N) with N.pick' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/rand\s*\(\s*(.+?)\s*\)/$1.pick/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

				# Fixes the following:
				# 	rand(10);
				# into:
				# 	(1..10).pick;
				push @items, {
					text     => Wx::gettext('Use (1..N).pick for a random number'),
					listener => sub {

						#Replace rand(N) with (1..N).pick' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/rand\s*\(\s*(.+?)\s*\)/(1..$1).pick/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Please use \.\.\* for indefinite range/i ) {

				# Fixes the following:
				# 	[1..];
				# into:
				# 	[1..*];
				push @items, {
					text     => Wx::gettext('Use [N..*] for indefinite range'),
					listener => sub {

						#Replace first '[1..]' with '[1..*]' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\[\s*(.+?)\.\.\s*\]/\[$1..*\]/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Please use \!\! rather than \:\:/i ) {

				# Fixes the following:
				# 	1 == 2 ?? 1 :: 2;
				# into:
				# 	1 == 2 ?? 1 !! 2;
				push @items, {
					text     => Wx::gettext('Use !! for conditional operator'),
					listener => sub {

						#Replace first '!!' with '::' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\:\:/!!/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Precedence too loose within \?\?\!\!/i ) {

				# Fixes errors like:
				# 	42 ?? 1,2,3 Z 4,5,6 !! 1,2,3 X 4,5,6;
				# into:
				# 	42 ?? (1,2,3 Z 4,5,6) !! 1,2,3 X 4,5,6;
				push @items, {
					text     => Wx::gettext('Use ?? (...) !! to avoid precedence bugs'),
					listener => sub {

						#Replace '?? ... !!' with '?? (...) !!' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );

						#XXX- handle multiple lines...
						$line_text =~ s/\?\?(.+?)\!\!/??($1)!!/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of \?\: for the conditional operator/i ) {

				# Fixes the following:
				# 	(1 == 1) ? 1 : 2
				# into:
				# 	(1 == 1) ?? 1 !! 2
				push @items, {
					text     => Wx::gettext('Use ?? !! for the conditional operator'),
					listener => sub {

						#Replace first '? ... :' with '?? ... !!' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\?\s*(.+?)\s*\:/?? $1 !!/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Possible obsolete use of \.\= as append operator/i ) {

				# Fixes the following:
				# 	$string .= "a";
				# into:
				# 	$string ~= "a";
				push @items, {
					text     => Wx::gettext('Use ~= for string concatenation'),
					listener => sub {

						#Replace first '=.' with '=~' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\.\=/~=/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of \=\~ to do pattern matching/i ) {

				# Fixes the following:
				# 	$string =~ /abc/;
				# into:
				# 	$string ~~ /abc/;
				push @items, {
					text     => Wx::gettext('Use ~~ for pattern matching'),
					listener => sub {

						#Replace first '=.' with '=~' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\=\~/~~/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of \!\~ to do negated pattern matching/i ) {

				# Fixes the following:
				# 	$string !~ /abc/;
				# into:
				# 	$string !~~ /abc/;
				push @items, {
					text     => Wx::gettext('Use !~~ for negated pattern matching'),
					listener => sub {

						#Replace first '!~' with '!~~' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\!\~/!~~/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of >> to do right shift/i ) {

				# Fixes the following:
				# 	2 >> 1;
				# into:
				# 	2 +> 1;
				push @items, {
					text     => Wx::gettext('Use +> for numeric right shift'),
					listener => sub {

						#Replace first '>>' with '+>' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\>\>/+>/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

				# Fixes the following:
				# 	100 >> 1;
				# into:
				# 	100 ~> 1;
				push @items, {
					text     => Wx::gettext('Use ~> for string right shift'),
					listener => sub {

						#Replace first '>>' with '~>' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\>\>/~>/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};
			} elsif ( $issue_msg =~ /^Obsolete use of << to do left shift/i ) {

				# Fixes the following:
				# 	2 << 1;
				# into:
				# 	2 +< 1;
				push @items, {
					text     => Wx::gettext('Use +< for numeric left shift'),
					listener => sub {

						#Replace first '<<' with '+<' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\<\</+</;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

				# Fixes the following:
				# 	100 << 1;
				# into:
				# 	100 ~< 1;
				push @items, {
					text     => Wx::gettext('Use ~< for string left shift'),
					listener => sub {

						#Replace first '<<' with '~<' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\<\</~</;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of \$\@ variable as eval error/i ) {

				# Fixes the following:
				# 	$@;
				# into:
				# 	$!;
				push @items, {
					text     => Wx::gettext('Use $! for eval errors'),
					listener => sub {

						#Replace first '$@' with '$!' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\$\@/\$!/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			} elsif ( $issue_msg =~ /^Obsolete use of \$\] variable/i ) {

				# Fixes the following:
				# 	$];
				# into:
				# 	$::PERL_VERSION;
				push @items, {
					text     => Wx::gettext('Use $::PERL_VERSION'),
					listener => sub {

						#Replace first '$]' with '$::PERL_VERSION' in the current line
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text =~ s/\$\]/\$::PERL_VERSION/;
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};

			}

		}

	}

	if ($num_issues) {

		# add "comment error line" as the last resort to solving an issue
		foreach my $issue ( @{ $doc->{issues} } ) {
			my $issue_line_no = $issue->{line} - 1;
			if ( $issue_line_no == $current_line_no ) {

				# Fixes the following:
				# 	some_weird_error();
				# into:
				# 	# some_weird_error();
				push @items, {
					text     => Wx::gettext('Comment error line'),
					listener => sub {

						# comment current error by putting a hash and a space
						# since #( is an embedded comment in Perl 6! see S02:166
						my $line_start = $editor->PositionFromLine($current_line_no);
						my $line_end   = $editor->GetLineEndPosition($current_line_no);
						my $line_text  = $editor->GetTextRange( $line_start, $line_end );
						$line_text = "# ${line_text}";
						$editor->SetSelection( $line_start, $line_end );
						$editor->ReplaceSelection($line_text);
					},
				};
				last;
			}
		}

	} else {

		# No issues; let us provide a some helpful quick fixes
		my $selected_text = $editor->GetSelectedText;
		if ( $selected_text && $selected_text =~ /[\n\r]/ ) {

			# Fixes the following:
			# 	faulty_code();
			# into:
			# 	try {
			#		faulty_code();
			#
			#		CATCH {
			#			warn "oops: $!";
			#		}
			#	}

			push @items, {
				text     => Wx::gettext('Surround with try { ... }'),
				listener => sub {

					# Surround the 'selection' with a try { 'selection'  CATCH { } }
					my $line_start =
						$editor->PositionFromLine( $editor->LineFromPosition( $editor->GetSelectionStart ) );
					my $line_end = $editor->PositionFromLine( $editor->LineFromPosition( $editor->GetSelectionEnd ) );

					my $indent = ( $selected_text =~ /(^\s+)/ ) ? $1 : '';
					$selected_text =~ s/^/\t/gm;
					my $line_text =
						  "${indent}try {$nl"
						. "$selected_text$nl"
						. "${indent}\tCATCH {$nl"
						. "${indent}\t\twarn \"oops: \$!\";$nl"
						. "${indent}\t}$nl"
						. "${indent}}$nl";
					$editor->SetSelection( $line_start, $line_end );
					$editor->ReplaceSelection($line_text);
				},
			};

		}

		# Not really a fix but a helper:
		# 	Converts POD6 to XHTML
		push @items, {
			text     => Wx::gettext('Convert POD6 to XHTML'),
			listener => sub {

				# Convert POD6 to XHTML using App::Grok
				my $text = $self->text_get;
				return if not defined $text;

				require File::Temp;
				my $tmp_input = File::Temp->new( SUFFIX => '.p6' );
				binmode( $tmp_input, ":utf8" );
				print $tmp_input $text;
				close $tmp_input or warn "cannot close $tmp_input\n";

				my $main = $editor->main;
				eval {
					require App::Grok;
					my $grok = App::Grok->new;
					my $grok_text = $grok->render_target( $tmp_input->filename, 'xhtml' );

					# create a temporary HTML file
					my $tmp_output = File::Temp->new( SUFFIX => '.html' );
					$tmp_output->unlink_on_destroy(0);
					print $tmp_output $grok_text;
					my $filename = $tmp_output->filename;
					close $tmp_output or warn "Could not close $filename";

					# try to open the HTML file
					$main->setup_editor($filename);

					# launch the HTML file in your default browser
					require URI::file;
					my $file_url = URI::file->new($filename);
					Wx::LaunchDefaultBrowser($file_url);
				};
				if ($@) {
					Wx::MessageBox(
						Wx::gettext('Operation failed!'),
						Wx::gettext('Error'),
						Wx::wxOK,
						$main,
					);
				}
			},
		};

		# Not really a fix but a helper:
		# 	Converts POD6 to Text
		push @items, {
			text     => Wx::gettext('Convert POD6 to Text'),
			listener => sub {

				# Convert POD6 to Text using App::Grok
				my $text = $self->text_get;
				return if not defined $text;

				require File::Temp;
				my $tmp_input = File::Temp->new( SUFFIX => '.p6' );
				binmode( $tmp_input, ":utf8" );
				print $tmp_input $text;
				close $tmp_input or warn "cannot close $tmp_input\n";

				my $main = $editor->main;
				eval {
					require App::Grok;
					my $grok = App::Grok->new;
					my $grok_text = $grok->render_target( $tmp_input->filename, 'text' );

					# create a temporary text file
					my $tmp_output = File::Temp->new( SUFFIX => '.txt' );
					$tmp_output->unlink_on_destroy(0);
					print $tmp_output $grok_text;
					my $filename = $tmp_output->filename;
					close $tmp_output or warn "Could not close $filename";

					# try to open the text file
					$main->setup_editor($filename);
				};
				if ($@) {
					Wx::MessageBox(
						Wx::gettext('Operation failed!'),
						Wx::gettext('Error'),
						Wx::wxOK,
						$main,
					);
				}
			},
		};
	}

	return @items;
}

1;





__END__