dev-precommit

#!/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();
}