Koha/misc/devel/tidy.pl

#!/usr/bin/env perl
use Modern::Perl;
use Getopt::Long;
use Pod::Usage;
use Try::Tiny;
use Array::Utils qw( array_minus );
use File::Slurp  qw( read_file write_file );
use IPC::Cmd     qw( run );
use Parallel::ForkManager;

my ( $perl_files, $js_files, $tt_files, $nproc, $no_write, $silent, $help );

our $perltidyrc = '.perltidyrc';

GetOptions(
    'perl'         => \$perl_files,
    'js'           => \$js_files,
    'tt'           => \$tt_files,
    'perltidyrc:s' => \$perltidyrc,
    'no-write'     => \$no_write,
    'nproc:s'      => \$nproc,
    'silent'       => \$silent,
    'help|?'       => \$help,
) or pod2usage(2);

pod2usage(1) if $help;

$nproc ||= qx{nproc};

my @files = @ARGV;

pod2usage("--no-write can only be passed with a single file") if $no_write && @files != 1;

pod2usage("--perl, --js and --tt can only be passed without any other files in parameter")
    if @files && ( $perl_files || $js_files || $tt_files );

my $exceptions = {
    pl => [qw(Koha/Schema/Result Koha/Schema.pm)],
    js => [
        qw(koha-tmpl/intranet-tmpl/lib koha-tmpl/intranet-tmpl/js/Gettext.js koha-tmpl/opac-tmpl/lib Koha/ILL/Backend/)
    ],
    tt => [qw(Koha/ILL/Backend/ *doc-head-open.inc misc/cronjobs/rss)],
};

my @original_files = @files;
if (@files) {

    # This is inefficient if the list of files is long but most of the time we will have only one
    @files = map {
        my $file     = $_;
        my $filetype = get_filetype($file);
        my $cmd      = sprintf q{git ls-files %s | grep %s}, build_git_exclude($filetype), $file;
        my $output   = qx{$cmd};
        chomp $output;
        $output ? $file : ();
    } @files;

    if ( scalar @files != scalar @original_files ) {
        my @diff = array_minus( @original_files, @files );
        for my $file (@diff) {
            my $cmd    = sprintf q{git ls-files %s}, $file;
            my $output = qx{$cmd};
            chomp $output;
            unless ($output) {
                l( sprintf "File '%s' not in the index, will be tidy anyway", $file );
                push @files, $file
                    ; # At the end of the index so the original order will be modified. This is not a feature and could be fixed later.
            }
        }
    }
} else {
    push @files, get_perl_files() if $perl_files;
    push @files, get_js_files()   if $js_files;
    push @files, get_tt_files()   if $tt_files;

    unless (@files) {
        push @files, get_perl_files();
        push @files, get_js_files();
        push @files, get_tt_files();
    }
}

if ( $no_write && !@files ) {

    # File should not be tidy, but we need to return the content or we risk data loss
    print read_file( $original_files[0] );
    exit;
}

my $nb_files = scalar @files;
my $pm       = Parallel::ForkManager->new($nproc);
my @errors;
$pm->run_on_finish(
    sub {
        my ( $pid, $exit_code, $ident, $exit_signal, $core_dump, $data_ref ) = @_;
        if ( defined $data_ref && $data_ref->{error} ) {
            push @errors, { error => $data_ref->{error}, file => $data_ref->{file} };
        }
    }
);

for my $index ( 0 .. $#files ) {
    my $file = $files[$index];
    $pm->start and next;

    l( sprintf "Tidying file %s/%s (%s)", $index + 1, $nb_files, $file );
    my $error;
    my ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) = tidy($file);
    unless ($success) {
        $error = join( '', @$stderr_buf ) || $error_message;
        chomp $error;
        warn $error;
    }

    $pm->finish( 0, { error => $error, file => $file } );
}
$pm->wait_all_children;

if (@errors) {
    l("\nSome files cannot be tidied:");
    l( sprintf( "\t* %s\n%s", $_->{file}, $_->{error} ) ) for @errors;
}

sub tidy {
    my ($file) = @_;

    my $filetype = get_filetype($file);

    if ( $filetype eq 'pl' ) {
        return tidy_perl($file);
    } elsif ( $filetype eq 'js' ) {
        return tidy_js($file);
    } elsif ( $filetype eq 'tt' ) {
        return tidy_tt($file);
    } else {
        die sprintf 'Cannot process file with filetype "%s"', $filetype;
    }
}

sub build_git_exclude {
    my ($filetype) = @_;
    return join( " ", map( "':(exclude)$_'", @{ $exceptions->{$filetype} } ) );
}

sub get_perl_files {
    my $cmd   = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc %s}, build_git_exclude('pl');
    my @files = qx{$cmd};
    chomp for @files;
    return @files;
}

sub get_js_files {
    my $cmd   = sprintf q{git ls-files '*.js' '*.ts' '*.vue' %s}, build_git_exclude('js');
    my @files = qx{$cmd};
    chomp for @files;
    return @files;
}

sub get_tt_files {
    my $cmd   = sprintf q{git ls-files '*.tt' '*.inc' %s}, build_git_exclude('js');
    my @files = qx{$cmd};
    chomp for @files;
    return @files;
}

sub tidy_perl {
    my ($file) = @_;
    my $cmd =
        $no_write
        ? sprintf q{perltidy --standard-output -pro=%s %s}, $perltidyrc, $file
        : sprintf q{perltidy --backup-and-modify-in-place --nostandard-output -pro=%s %s}, $perltidyrc, $file;

    print qx{$cmd};
}

sub tidy_js {
    my ($file) = @_;
    my $cmd    = sprintf q{yarn --silent run prettier %s%s}, ( $no_write ? '' : '--write ' ), $file;
    print qx{$cmd};
}

sub tidy_tt {
    my ($original_file) = @_;
    my ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf );

    my ( $file_fh, $file );    # Keep this scope for $file_fh, or the file will be deleted after the following block
    if ($no_write) {
        $file_fh = File::Temp->new( CLEANUP => 1, SUFFIX => '.tt', DIR => '.' );
        $file    = $file_fh->filename;
        write_file( $file, read_file($original_file) );
    } else {
        $file = $original_file;
    }

    for my $pass ( 1 .. 2 ) {
        ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) =
            run( command => sprintf( q{yarn --silent run prettier --write %s}, $file ) );

        if ($success) {

            # Revert the substitutions done by the prettier plugin
            my $content = read_file($file);
            $content =~ s#<!--</head>-->#</head>#g;
            $content =~ s#<!--<body(.*)-->#<body$1#g;
            $content =~ s#<!--</body>-->#</body>#g;
            $content =~ s#\n*( *)<script>\n*#\n$1<script>\n#g;
            $content =~ s#\n*( *)</script>\n*#\n$1</script>\n#g;
            $content =~ s#(\[%\s*SWITCH[^\]]*\]\n)\n#$1#g;

            if ( $no_write && $pass == 2 ) {
                print $content;
            } else {
                write_file( $file, $content );
            }
        }
    }
    return ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf );
}

sub get_filetype {
    my ($file) = @_;
    return 'pl' if $file =~ m{^svc}  || $file =~ m{^opac/svc};
    return 'pl' if $file =~ m{\.pl$} || $file =~ m{\.pm} || $file =~ m{\.t$};
    return 'pl' if $file =~ m{\.PL$};

    return 'js' if $file =~ m{\.js$} || $file =~ m{\.ts$} || $file =~ m{\.vue$};

    return 'tt' if $file =~ m{\.inc$} || $file =~ m{\.tt$};

    die sprintf 'Cannot guess filetype for %s', $file;
}

sub l {
    say shift unless $silent;
}

=head1 NAME

tidy.pl - Tidy Perl, Javascript, Vue and Template::Toolkit files.

=head1 SYNOPSIS

tidy.pl [options] [files]

 Options:
   --perl            Tidy the Perl files (.t, .pm, .pl)
   --js              Tidy the JavaScript files (.js, .ts, .vue)
   --tt              Tidy the Template::Tolkit files (.inc, .tt)
   --perltidyrc      .perltidyrc files to use for perltidy (default: .perltidyrc)
   --no-write        Do not modify the file, output the tidy version to STDOUT
   --nproc           Number of processes to use (default to all available)
   --silent          Silent mode
   --help            Show this help message

=head1 DESCRIPTION

This script will tidy the different files present in the git repository.

If the file is an exception and should be tidy, it will be skipped.
However if only one file is passed with --no-write then the content of the file will be print to STDOUT.

=head1 EXAMPLES

Tidy everything:

  ./tidy.pl

Tidy only the Perl files:

  ./tidy.pl --perl

Tidy only the JavaScript files:

  ./tidy.pl --js

Tidy only the Template::Toolkit files:

  ./tidy.pl --tt

Tidy only some specific files:

  ./tidy.pl list of files

Output the tidy version of a file:

  ./tidy.pl --no-write /path/to/file

Output the tidy version of a file without other information:

  ./tidy.pl --silent --no-write /path/to/file

=head1 AUTHOR

Jonathan Druart <jonathan.druart@bugs.koha-community.org>

=cut