BEGIN {
$Padre::Plugin::PerlCritic::VERSION
=
'0.12'
;
}
use
5.008;
our
@ISA
=
'Padre::Plugin'
;
sub
padre_interfaces {
'Padre::Plugin'
=>
'0.47'
,;
}
sub
plugin_name {
Wx::gettext(
'Perl Critic'
);
}
sub
menu_plugins_simple {
my
$self
=
shift
;
return
$self
->
plugin_name
=> [
Wx::gettext(
'Perl::Critic Current Document'
) =>
sub
{
$self
->critic(
@_
);
}
];
}
sub
critic {
my
$self
=
shift
;
my
$current
=
$self
->current;
$DB::single
= 1;
my
$document
=
$current
->document or
return
;
unless
(
$document
->isa(
'Padre::Document::Perl'
) ) {
return
Wx::MessageBox(
Wx::gettext(
'Document is not a Perl document'
),
Wx::gettext(
'Error'
),
Wx::wxOK | Wx::wxCENTRE,
$self
,
);
}
my
$text
=
$document
->text_get;
return
unless
defined
$text
;
my
$project
=
$document
->project;
my
$config
=
$project
->config;
my
$config_perlcritic
=
$config
->config_perlcritic;
my
@params
=
$config_perlcritic
? (
-profile
=>
$config_perlcritic
)
: ();
my
$main
=
$current
->main;
my
$output
=
$main
->output;
$output
->clear;
$main
->show_output(1);
if
(
@params
) {
$output
->AppendText(
sprintf
( Wx::gettext(
'Perl::Critic running with project-specific configuration %s'
),
$config_perlcritic
)
.
"\n"
);
}
else
{
$output
->AppendText( Wx::gettext(
"Perl\::Critic running with default or user configuration"
) .
"\n"
);
}
my
$critic
= Perl::Critic->new(
@params
);
my
@violations
=
$critic
->critique( \
$text
);
if
(
@violations
) {
$output
->AppendText(
join
''
,
@violations
);
}
else
{
$output
->AppendText( Wx::gettext(
'Perl::Critic found nothing to say about this code'
) .
"\n"
);
}
return
;
}
1;