Padre::Task::ClassSniff - Running class sniff in the background

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

Index

Code Index:

NAME

Top

Padre::Task::ClassSniff - Running class sniff in the background

SYNOPSIS

Top

  my $task = Padre::Task::ClassSniff->new(
    mode => 'print_report',
    sniff_config => { ... },
  );
  $task->schedule;

DESCRIPTION

Top

Runs Class::Sniff on the first namespace of the current document and prints the results to the Padre output window.

SEE ALSO

Top

This class inherits from Padre::Task::WithOutput and its instances can be scheduled using Padre::TaskManager.

The transfer of the objects to and from the worker threads is implemented with Storable.

AUTHOR

Top

Steffen Mueller <smueller@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright 2008-2009 The Padre development team as listed in Padre.pm.

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

Padre-Plugin-ClassSniff documentation Contained in the Padre-Plugin-ClassSniff distribution. 
package Padre::Task::ClassSniff;

use strict;
use warnings;
use Padre::Task::PPI ();
use Padre::Wx        ();
use Padre::Util      ('_T');
use Scalar::Util     qw(blessed);
use IPC::Cmd         ();

our $VERSION = '0.29';
use base 'Padre::Task::PPI';


sub process_ppi {
	my $self = shift;
	my $ppi = shift or return();
	my $mode = $self->{mode} || 'print_report';
	
	
	my $sniff_config = $self->{sniff_config} ||= {};
	
	if (not defined $sniff_config->{class}) {
		$sniff_config->{class} = $self->find_document_namespace($ppi);
	}
	
	if ($mode eq 'print_report') {
		$self->print_report($ppi);
	}
	
	return();
}

sub find_document_namespace {
	my $self = shift;
	my $ppi = shift;
	my $ns = $ppi->find_first( 'PPI::Statement::Package' );
	return()
	  if not defined $ns or !blessed($ns) or !$ns->isa('PPI::Statement::Package');
	return $ns->namespace;
}

sub print_report {
	my $self = shift;
	my $ppi = shift;
	my $sniff_config = $self->{sniff_config};
	
	if (not defined $sniff_config->{class}) {
		$self->task_warn(_T("Could not determine class to run Sniff on.\n"));
		return();
	}

	my ($ok, $stdout, $stderr) = $self->run_sniff($sniff_config, $self->{text}||$ppi->serialize());
	if (!$ok or not defined $stdout) {
		$self->task_warn(
			"Error running Class::Sniff on class '"
			. $sniff_config->{class} . "': "
			. $stderr
			. "\n"
		);
		return();
	}
	if (defined $stderr and $stderr =~ /\S/) {
		$self->task_warn(
			"Warning from running Class::Sniff on class '"
			. $sniff_config->{class} . "': "
			. $stderr
			. "\n"
		);
	}
	
	if (defined $stdout and $stdout =~ /\S/) {
		$self->task_print( $stdout . "\n" );
	}
	else {
		$self->task_print( "No bad smell from class '" . $sniff_config->{class} . "'\n" );
	}
	return();

}

sub run_sniff {
	my $self = shift;
	my $cfg = shift;
	my $code = shift;
	
	require YAML::Tiny;
	require IPC::Cmd;
	require IPC::Open3;
	
	my $yaml = YAML::Tiny::Dump($cfg);
	my @cmd = (
		Padre->perl_interpreter(),
		'-Mstrict',
		'-Mwarnings',
		'-mYAML::Tiny',
		'-mClass::Sniff',
		'-e',
	);
	push @cmd, <<'HERE';
	my $yaml = YAML::Tiny::Load(shift(@ARGV)) or die "Bad config";
	$yaml = $yaml->[0] if ref($yaml) eq 'ARRAY';
	my $code = shift(@ARGV);
	eval $code;
	die "Could not compile class: $@" if $@;
	my $sniff = Class::Sniff->new($yaml);
	die "Could not instantiate Class::Sniff" if not $sniff;
	print $sniff->report();
HERE
	push @cmd, '--', $yaml, $code;
	
	my ($ok, $errno, undef, $stdout, $stderr)
	  = IPC::Cmd::run( command => \@cmd, verbose => 0 );
	$stdout = join "", @$stdout
	  if defined $stdout and ref($stdout) eq 'ARRAY';
	$stderr = join "", @$stderr
	  if defined $stderr and ref($stderr) eq 'ARRAY';
	return ($ok, $stdout, $stderr);
}

1;

__END__



# Copyright 2008-2009 The Padre development team as listed in Padre.pm.
# LICENSE
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl 5 itself.