123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374 |
- #!/usr/bin/perl
- use local::lib;
- use v5.10;
- use strict;
- use warnings;
- use FindBin qw( $RealBin );
- use lib "$RealBin/lib";
- use Cwd qw( abs_path );
- use File::Basename qw( basename );
- use File::Find qw( find );
- use List::Util qw( any );
- use LogBot::Util qw( file_time run );
- use Mojo::File ();
- use Mojo::Util qw( trim );
- use Perl::Critic ();
- use Perl::Tidy ();
- $| = 1;
- chdir($RealBin);
- our @ARGV = ();
- # tabs
- find(
- sub {
- return unless -f $File::Find::name && -s $File::Find::name;
- my $file = substr($File::Find::name, 2);
- return if $file =~ m{/} && $file !~ m{^(?:lib|web)/};
- return if basename($file) =~ /^\./ || $file =~ /\.(bak|swp|png|ttf)$/;
- return if $file eq 'makefile' or $file eq 'perltidy.ERR';
- my $content = Mojo::File->new("$RealBin/$file")->slurp();
- return unless $content =~ /\t/;
- say "\e[31m$file contains tabs\e[0m";
- },
- '.'
- );
- # tidy sass (sort selectors)
- foreach my $file (glob('web/*.sass')) {
- next if basename($file) =~ /^_/;
- print $file;
- if (!is_modified($file)) {
- say ' unchanged';
- next;
- }
- my @original = split(/\n/, Mojo::File->new($file)->slurp());
- my @output;
- my @variables;
- my $chunk = {};
- reset_chunk($chunk);
- foreach my $line (@original) {
- my $indent = $line =~ /^(\s+)/ ? length($1) : 0;
- if ($line eq '') {
- push @output, process_chunk($chunk);
- push @output, '';
- $chunk->{indent} = $indent;
- next;
- }
- if ($line =~ /^(\$[^:]+):.+$/) {
- push @variables, $1;
- }
- if ($indent != $chunk->{indent}) {
- push @output, process_chunk($chunk);
- $chunk->{indent} = $indent;
- push @{ $chunk->{lines} }, $line;
- next;
- }
- push @{ $chunk->{lines} }, $line;
- }
- push @output, process_chunk($chunk);
- sub reset_chunk {
- my ($ch) = @_;
- $ch->{indent} = -1;
- $ch->{lines} = [];
- }
- sub process_chunk {
- my ($ch) = @_;
- my @lines =
- sort {
- return -1 if $a =~ m{^\s*//};
- return 1 if $b =~ m{^\s*//};
- return $a cmp $b;
- } @{ $ch->{lines} };
- reset_chunk($ch);
- return @lines;
- }
- my $original = join("\n", @original) . "\n";
- my $output = join("\n", @output) . "\n";
- if ($original ne $output) {
- say " \e[34mupdated\e[0m";
- Mojo::File->new($file)->spurt($output);
- } else {
- say ' unchanged';
- }
- set_modified($file);
- foreach my $var (@variables) {
- my $count = 0;
- $count++ while $output =~ /\Q$var\E/g;
- say "\e[33munused sass variable: ", $var, "\e[0m" if $count == 1;
- }
- }
- # tidy all the perl as per .perltidy
- # critic all the perl as per .perlcriticrc
- my $critic = Perl::Critic->new(-profile => $RealBin . '/.perlcriticrc');
- find(
- sub {
- # look for files in . and under lib/
- my $file = $File::Find::name;
- return unless -f $file && -s $file;
- my $rel_file = substr($file, length($RealBin) + 1);
- return if $rel_file =~ m{/} && $rel_file !~ m{^lib/};
- return if basename($rel_file) =~ /^\./ || $rel_file =~ /\.(bak|swp)$/;
- # detect perl by file extension or #!
- my $is_perl = 0;
- if ($file =~ /\.p[ml]$/) {
- $is_perl = 1;
- } else {
- open(my $fh, '<', $file) or die "open $file $!\n";
- my ($first_line) = <$fh>;
- close($fh) or die $!;
- $is_perl = $first_line =~ m{\#!/usr/bin/perl};
- }
- return unless $is_perl;
- print $rel_file;
- if (!is_modified($file)) {
- say ' unchanged';
- return;
- }
- # init
- my $original = Mojo::File->new($file)->slurp();
- my $input = $original;
- my $output = '';
- # sort use lines, as well as their imports
- $input = sort_use($input);
- # apply perltidy
- Perl::Tidy::perltidy(
- source => \$input,
- destination => \$output,
- );
- # apply changes
- if ($original ne $output) {
- Mojo::File->new($file)->spurt($output);
- say " \e[34mupdated\e[0m";
- } else {
- say ' unchanged';
- }
- # critic
- my @issues = $critic->critique($file);
- my $has_issues = !!scalar(@issues);
- foreach my $issue (@issues) {
- (my $policy = $issue->policy) =~ s/^Perl::Critic::Policy:://;
- say "\e[33m", $rel_file, ':', $issue->line_number, ' ', $issue->description, ' (', $policy, ")\e[0m";
- }
- # warn for unused imports
- @issues = find_unused_imports($input);
- $has_issues ||= !!scalar(@issues);
- foreach my $issue (@issues) {
- say "\e[33m", $rel_file, ': ', $issue, "\e[0m";
- }
- if ($has_issues) {
- clear_modified($file);
- } else {
- set_modified($file);
- }
- },
- $RealBin
- );
- # javascript
- foreach my $js_file (qw( web/logbot.js web/redirect.js )) {
- run('js-beautify', '-r', '-n', $js_file);
- run('jshint', $js_file);
- }
- # make static assets
- run("$RealBin/dev-make", '-B');
- sub sort_use {
- my ($input) = @_;
- return foreach_use_block(
- $input,
- sub {
- my @uses = @_;
- # sort imports
- foreach my $line (@uses) {
- next unless $line =~ /^(use\s+\S+)\s+qw\(([^\)]+)\);$/;
- my ($module, $imports) = ($1, $2);
- my @imports = split(/\s+/, trim($imports));
- $imports = join(' ', sort @imports);
- $line = "$module qw( $imports );";
- }
- # sort modules
- return [sort { lc($a) cmp lc($b) } @uses];
- }
- );
- }
- sub find_unused_imports {
- my ($input) = @_;
- my (%modules, %imports);
- foreach_use_block(
- $input,
- sub {
- my @uses = @_;
- foreach my $line (@uses) {
- if ($line =~ /^use\s+(\S+)\s+\(\);$/) {
- $modules{$1} = 1;
- } elsif ($line =~ /^(use\s+\S+)\s+qw\(([^\)]+)\);$/) {
- my ($module, $imports) = ($1, $2);
- my @imports = split(/\s+/, trim($imports));
- foreach my $import (@imports) {
- next if $import =~ m{^[:/]};
- $imports{$import} = 1;
- }
- }
- }
- return undef;
- }
- );
- $input = join("\n", grep { !/^use\s/ } split(/\n/, $input));
- my @issues;
- foreach my $module (sort keys %modules) {
- next if $input =~ /\b$module(?:->|::)/ || $input =~ /'$module'/;
- push @issues, "package $module is unused";
- }
- foreach my $import (sort keys %imports) {
- if ($import =~ /^\$/) {
- next if $input =~ /\Q$import\E\b/;
- } else {
- next if $input =~ /\b\Q$import\E\b/;
- }
- push @issues, "import $import is unused";
- }
- return @issues;
- }
- sub foreach_use_block {
- my ($input, $callback) = @_;
- # use-block is replaced by callback's return, unless callback returns undef
- # find use blocks, assumes they are always followed by a blank line
- my @output;
- my $in_use_block = 0;
- my @uses;
- foreach my $line (split(/\n/, $input)) {
- if ($in_use_block) {
- if ($line eq '') {
- $in_use_block = 0;
- process_uses(\@uses, \@output, $callback);
- @uses = ();
- next;
- }
- }
- if ($line =~ /^use /) {
- $in_use_block = 1;
- push @uses, $line;
- next;
- }
- push @output, $line;
- }
- process_uses(\@uses, \@output, $callback);
- return join("\n", @output) . "\n";
- }
- sub process_uses {
- my ($uses, $output, $callback) = @_;
- return unless @{$uses};
- # skip setup / lib blocks
- if (any { /^use local::lib/ || /^use lib / || /^use base / } @{$uses}) {
- push @{$output}, @{$uses}, '';
- } else {
- my $replace = $callback->(@{$uses});
- if (defined $replace) {
- push @{$output}, @{$replace}, '';
- } else {
- push @{$output}, @{$uses}, '';
- }
- }
- }
- # lastmod tracking
- my $lastmod;
- sub _init_modified {
- return if defined $lastmod;
- $lastmod = {};
- if (open(my $fh, '<', "$RealBin/.dev-precommit")) {
- while (<$fh>) {
- next unless /^(.+)\t(\d+)$/;
- $lastmod->{$1} = $2;
- }
- close($fh) || die $!;
- }
- if (is_modified("$RealBin/dev-precommit")) {
- $lastmod = {};
- _write_modified();
- }
- }
- sub _write_modified {
- open(my $fh, '>', "$RealBin/.dev-precommit") or die $!;
- foreach my $fn (sort keys %{$lastmod}) {
- say {$fh} "$fn\t" . $lastmod->{$fn};
- }
- close($fh) or die $!;
- }
- sub is_modified {
- my ($file) = @_;
- _init_modified();
- my $mtime = file_time($file);
- my $abs_file = abs_path($file);
- $lastmod->{$abs_file} //= 0;
- return $lastmod->{$abs_file} != $mtime;
- }
- sub set_modified {
- my ($file) = @_;
- _init_modified();
- $lastmod->{ abs_path($file) } = file_time($file);
- _write_modified();
- }
- sub clear_modified {
- my ($file) = @_;
- _init_modified();
- delete $lastmod->{ abs_path($file) };
- _write_modified();
- }
|