On Wed, Jul 9, 2008 at 11:05 PM, Perrin Harkins <[EMAIL PROTECTED]> wrote:

> I'm thrilled to hear that this ultimately was valuable because I
> suggested that policy.  It would be great if you'd share your hack to
> make Critic work on Mason code somewhere.


Oh, yeah, sure.  Here's my test script.  It just takes the compiled Mason
object and runs it through Critic.  Also, the last half is shamelessly
cribbed from Test::Perl::Critic.

This is less useful than it seems because Mason's object code output doesn't
pass Perl::Critic itself :)  But it's probably a start for someone to
improve upon -- maybe modulize it and throw it on CPAN.  Or maybe improve
Mason's code output so it does pass a critique.

#!/usr/bin/perl
use strict;
use warnings;
no warnings qw(once);

use File::Find ();
use HTML::Mason::Compiler::ToObject ();
use Perl::Critic ();
use Test::More;

my $critic = Perl::Critic->new(
  -profile => 't/perlcriticrc',
);

local *HTML::Mason::Commands::r = \"0";

my @files;
my $wanted = sub {
  return if -d $_;
  return if $_ eq 'favicon.ico';
  return if $File::Find::name =~ /\.svn|images|javascript|css/;
  push @files, $File::Find::name;
};
File::Find::find($wanted, 'htdocs');

plan tests => scalar(@files);

foreach my $file (@files) {
  my(@vios);
  eval {
    my $src;
    { local $/ = undef;
      open(my $foo, $file) or die "Couldn't open $file: $!";
      $src = <$foo>;
    }

    my $compiler = HTML::Mason::Compiler::ToObject->new;
    my $object_code = $compiler->compile(
      comp_source => \$src,
      name => $file,
      comp_path => 'htdocs',
    );

    @vios = $critic->critique($object_code, -severity => 1);
  };

  if ($@) {
    fail($file);
    diag("\n");
    diag(qq{Perl::Critic had errors in "$file":});
    diag([EMAIL PROTECTED]);
  } elsif (@vios) {
    fail($file);
    diag("\n");
    diag(qq{Perl::Critic found these violations in "$file":});
    my $verbose = $critic->config->verbose();
    Perl::Critic::Violation::set_format( $verbose );
    foreach my $vio (@vios) { diag("$vio") }
  } else {
    pass($file);
  }
}

-- 
Stephen Clouse <[EMAIL PROTECTED]>

Reply via email to