[libcode-tidyall-perl] 03/374: various

Jonas Smedegaard js at alioth.debian.org
Sun Sep 29 22:25:38 UTC 2013


This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository libcode-tidyall-perl.

commit 759dfc8610e9dcde86dbd68372b955042effc4db
Author: Jonathan Swartz <swartz at pobox.com>
Date:   Fri May 18 17:11:47 2012 -0700

    various
---
 lib/Code/TidyAll.pm                 |  105 ++++++++++++++++++++++-------------
 lib/Code/TidyAll/Plugin.pm          |   42 ++++++++++++++
 lib/Code/TidyAll/Plugin/PerlTidy.pm |   20 +++++++
 lib/Code/TidyAll/Util.pm            |    9 ---
 lib/Code/TidyAll/t/Sanity.pm        |   14 -----
 t/02-tidy.t                         |    6 ++
 6 files changed, 135 insertions(+), 61 deletions(-)

diff --git a/lib/Code/TidyAll.pm b/lib/Code/TidyAll.pm
index e45c2f6..af3d197 100644
--- a/lib/Code/TidyAll.pm
+++ b/lib/Code/TidyAll.pm
@@ -1,41 +1,70 @@
 package Code::TidyAll;
-use 5.008;
-use strict;
-use warnings;
+use Moose;
+use Method::Signatures::Simple;
+use Digest::SHA1 qw(sha1_hex);
+use List::Pairwise qw(mapp);
+
+has 'base_sig' => ( is => 'ro', init_arg => undef, lazy_build => 1 );
+has 'cache'    => ( is => 'ro', lazy_build => 1 );
+has 'conf'     => ( is => 'ro', lazy_build => 1 );
+has 'files'    => ( is => 'ro', lazy_build => 1 );
+has 'plugins'  => ( is => 'ro', lazy_build => 1 );
+has 'root_dir' => ( is => 'ro', required => 1 );
+
+method tidyall () {
+    my $cache = $self->cache;
+    foreach my $file ( @{ $self->files } ) {
+        if ( -f $file
+            && ( $cache->get($file) || '' ) ne $self->_file_sig($file) )
+        {
+            $self->process_file($file);
+            $cache->set( $file, $self->_file_sig($file) );
+        }
+    }
+}
+
+method _build_cache () {
+    require CHI;
+    return CHI->new(
+        driver   => 'File',
+        root_dir => $self->root_dir . "/.tidyall_cache"
+    );
+}
+
+method _build_base_sig () {
+    return $self->_sig( [ $Code::TidyAll::VERSION, $self->conf ] );
+}
+
+method _build_plugins () {
+    return mapp { $self->load_plugin( $a, $b ) } %{ $self->conf->{plugins} };
+}
+
+method load_plugin ($plugin_name, $plugin_conf) {
+    my $class_name = (
+        $plugin_name =~ /^\+/
+        ? substr( $plugin_name, 1 )
+        : "Code::TidyAll::Plugin::$plugin_name"
+    );
+    Class::MOP::load_class($class_name);
+    return $class_name->new( conf => $plugin_conf, name => $plugin_name );
+}
+
+method process_file ($file) {
+    foreach my $plugin ( @{ $self->plugins } ) {
+        if ( $plugin->matcher->($file) ) {
+            $plugin->process_file($file);
+        }
+    }
+}
+
+method _file_sig ($file) {
+    my $last_mod = ( stat($file) )[9];
+    my $contents = read_file($file);
+    return $self->_sig( [ $self->base_sig, $last_mod, $contents ] );
+}
+
+method _sig ($data) {
+    return sha1_hex( encode_json($data) );
+}
 
 1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Code::TidyAll - Tidy and validate code in many ways at once
-
-=head1 SYNOPSIS
-
-    use Code::TidyAll;
-
-=head1 DESCRIPTION
-
-Code::TidyAll provides
-
-Questions and feedback are welcome, and should be directed to the mailing list:
-
-    http://groups.google.com/...
-
-Bugs and feature requests will be tracked at RT:
-
-    http://rt.cpan.org/NoAuth/Bugs.html?Dist=Code-TidyAll
-    bug-code-tidyall at rt.cpan.org
-
-The latest source code can be browsed and fetched at:
-
-    http://github.com/jonswar/perl-code-tidyall
-    git clone git://github.com/jonswar/perl-code-tidyall.git
-
-=head1 SEE ALSO
-
-L<Some::Module>
-
diff --git a/lib/Code/TidyAll/Plugin.pm b/lib/Code/TidyAll/Plugin.pm
new file mode 100644
index 0000000..99bb678
--- /dev/null
+++ b/lib/Code/TidyAll/Plugin.pm
@@ -0,0 +1,42 @@
+package Code::TidyAll::Plugin;
+use Moose;
+use Method::Signatures::Simple;
+
+has 'conf'    => ( is => 'ro', required => 1 );
+has 'matcher' => ( is => 'ro', init_arg => undef, lazy_build => 1 );
+has 'name'    => ( is => 'ro', required => 1 );
+
+method process_file ($file) {
+    my $source = read_file($file);
+    my $dest   = $self->process_source($source);
+    write_file( $file, $dest );
+}
+
+method _build_matcher () {
+    my $conf = $self->conf;
+
+    my $include = $conf->{include}
+      || die "no include configured for plugin " . $self->name;
+    my $exclude = $conf->{include} || sub { 0 };
+    $include = _match_spec_to_coderef( 'include', $include );
+    $exclude = _match_spec_to_coderef( 'exclude', $exclude );
+
+    return sub {
+        $include->($file) && !$exclude->($file);
+    };
+}
+
+func _match_spec_to_coderef ($type, $spec) {
+    $spec = qr/$spec/ if ( !ref($spec) );
+    if ( ref($spec) eq 'Regexp' ) {
+        $coderef{$type} = sub { $_[0] =~ $spec };
+    }
+    elsif ( ref($spec) eq 'CODE' ) {
+        $coderef{$type} = $spec;
+    }
+    else {
+        die sprintf( "bad '%s' conf value for plugin '%s': '%s'", $type, $self->name, $spec );
+    }
+}
+
+1;
diff --git a/lib/Code/TidyAll/Plugin/PerlTidy.pm b/lib/Code/TidyAll/Plugin/PerlTidy.pm
new file mode 100644
index 0000000..679a37c
--- /dev/null
+++ b/lib/Code/TidyAll/Plugin/PerlTidy.pm
@@ -0,0 +1,20 @@
+package Code::TidyAll::Plugin::PerlTidy;
+use Moose;
+extends 'Code::TidyAll::Plugin';
+
+sub include_files { qr/\.(pl|pm|t)$/ }
+
+sub process_source {
+    my ( $self, $source ) = @_;
+    my $conf = $self->conf;
+    Perl::Tidy::perltidy(
+        %$conf,
+        source      => $source,
+        destination => \my $destination,
+        stderr      => \my $stderr,
+    );
+    die $stderr if $stderr;
+    return $destination;
+}
+
+1;
diff --git a/lib/Code/TidyAll/Util.pm b/lib/Code/TidyAll/Util.pm
deleted file mode 100644
index 7d3eb78..0000000
--- a/lib/Code/TidyAll/Util.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-package Code::TidyAll::Util;
-use strict;
-use warnings;
-use base qw(Exporter);
-
-our @EXPORT_OK = qw(
-);
-
-1;
diff --git a/lib/Code/TidyAll/t/Sanity.pm b/lib/Code/TidyAll/t/Sanity.pm
deleted file mode 100644
index 6de718c..0000000
--- a/lib/Code/TidyAll/t/Sanity.pm
+++ /dev/null
@@ -1,14 +0,0 @@
-package Code::TidyAll::t::Sanity;
-use strict;
-use warnings;
-use base qw(Test::Class);
-
-# or
-# use Test::Class::Most parent => 'Code::TidyAll::Test::Class';
-
-sub test_ok : Test(1) {
-    my $self = shift;
-    ok(1);
-}
-
-1;
diff --git a/t/02-tidy.t b/t/02-tidy.t
new file mode 100644
index 0000000..1b7c57b
--- /dev/null
+++ b/t/02-tidy.t
@@ -0,0 +1,6 @@
+#!perl
+use Test::More;
+
+use_ok('Code::TidyAll');
+ok(1);
+done_testing();

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcode-tidyall-perl.git



More information about the Pkg-perl-cvs-commits mailing list