#!/trw/local/perl/default/bin/perl 

use 5.006001;

use strict;
use warnings;

use English qw{ -no_match_vars };
use Getopt::Long 2.33 qw{ :config auto_version };
use Perl::Critic;
use Perl::Critic::Utils qw{ all_perl_files $SPACE };
use Perl::Critic::Violation;
# The following is superfluous as far as Perl::Critic is concerned, but
# handy if we want to run the debugger.
use Perl::Critic::Policy::Variables::ProhibitUnusedVarsStricter;
use Readonly;
use Pod::Usage;

our $VERSION = '0.115_01';

Readonly::Scalar my $DEFAULT_SINGLE_FILE_FORMAT => 4;
Readonly::Scalar my $DEFAULT_MULTI_FILE_FORMAT  => 5;
Readonly::Array my @INVERTED_OPTIONS    => qw{
    prohibit_reference_only_variables
    prohibit_returned_lexicals
};
Readonly::Scalar my $REF_ARRAY  => ref [];

my %opt = map { $_ => 1 } @INVERTED_OPTIONS;

GetOptions( \%opt, qw{
        allow_if_computed_by|computed-by=s@
        allow_unused_subroutine_arguments|subroutine-arguments!
        allow_state_in_expression|state-in-expression!
        check_catch|check-catch|catch!
        prohibit_reference_only_variables|reference-only-variables!
        prohibit_returned_lexicals|returned-lexicals!
        dump! trace=s
    },
    'format=s'  => \( my $format ),
    'verbose!'  => \( my $verbose ),
    help => sub { pod2usage( { -verbose => 2 } ) },
) or pod2usage( { -verbose => 0 } );

foreach my $key ( @INVERTED_OPTIONS ) {
    ( $opt{$key} = ! $opt{$key} )
        or delete $opt{$key};
}

foreach ( values %opt ) {
    $REF_ARRAY eq ref
        and $_ = join $SPACE, @{ $_ };
}

if ( ! @ARGV ) {
    -e 'MANIFEST'
        or die "No arguments specified and no MANIFEST found\n";
    require ExtUtils::Manifest;
    my $manifest = ExtUtils::Manifest::maniread();
    @ARGV = sort all_perl_files( keys %{ $manifest } )  ## no critic (RequireLocalizedPunctuationVars)
}

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

$critic->add_policy(
    -policy => 'Variables::ProhibitUnusedVarsStricter',
    -params => \%opt
);

{
    no warnings qw{ newline };  ## no critic (ProhibitNoWarnings)
    Perl::Critic::Violation::set_format(
        defined $format ? $format :
        ( @ARGV > 1 || -d $ARGV[0] ) ?
            $DEFAULT_MULTI_FILE_FORMAT :
            $DEFAULT_SINGLE_FILE_FORMAT
    );
}

foreach my $fn ( @ARGV ) {

    no warnings qw{ newline };  ## no critic (ProhibitNoWarnings)
    foreach my $pf ( -e $fn ? all_perl_files( $fn ) : \$fn ) {
        my @violations = Perl::Critic::Violation::sort_by_location(
            $critic->critique( $pf ) );

        if ( @violations ) {
            foreach ( @violations ) {
                print;
            }
        } elsif ( $verbose ) {
            local $_ = Perl::Critic::Violation::get_format();
            local $OUTPUT_RECORD_SEPARATOR = "\n";
            print m/ (?: \A | (?<= [^%] ) ) (?: %% )* %f /smx ?
                "$pf source OK" : 'source OK';
        }
    }
}

__END__

=head1 NAME

unused-vars - Find unused variables in Perl code

=head1 SYNOPSIS

 unused-vars .
 unused-vars lib/
 unused-vars -help
 unused-vars -version

=head1 OPTIONS

The following options are accepted by this script. They are documented
with leading double dashes, but single dashes are accepted, as are
unique abbreviations.

=head2 --catch

This option is a synonym for L<--check-catch|/--check-catch>.

=head2 --check-catch

 --check-catch

If this Boolean option is asserted, the C<catch()> portion of a
try/catch construction is checked.

The default is C<--no-check-catch>.

=head2 --computed-by

 --computed-by scope_guard

Variables computed by subroutines or methods specified to this option
are ignored. It can be specified more than once.

=head2 --dump

 --dump

This B<unsupported> Boolean option causes a dump of variables and their
declarations to C<STDERR>.

This option and its effects can be changed or retracted without notice.

=head2 --format

 --format 5

This option specifies the F<perlcritic> format to use for output. This
corresponds to the F<perlcritic> C<--verbose> option, takes the same
values, and has the same default.

=head2 --help

This option displays the documentation for this script. The script then
exits.

=head2 --reference-only-variables

If this Boolean option is asserted, variables whose reference is taken,
but which are otherwise unused, are permitted.

The default is C<--reference-only-variables>, but this can be overridden
by specifying C<--no-reference-only-variables>.

=head2 --returned-lexicals

If this Boolean option is asserted, otherwise-unused lexical variables
are permitted if they are returned from a subroutine.

The default is C<--returned-lexicals>, but this can be overridden by
specifying C<--no-returned-lexicals>.

=head2 --state-in-expression

If this Boolean option is asserted, otherwise-unused C<state> variables
are allowed in expressions that appear to make used of the value of the
variable.

The default is C<--no-state-in-expression>

=head2 --subroutine-arguments

If this Boolean option is asserted, unused variables unpacked from
subroutine arguments are ignored.

The default is C<--no-subroutine-arguments>.

=head2 --trace

 --trace '$foo %bar'

This B<unsupported> option causes all definitions and uses of the given
variables to be displayed to C<STDERR>. Multiple variables are
space-separated. True sigils are used -- that is, C<$foo> refers only to
the scalar.

This option and its effects may be changed or retracted without notice.

=head2 --verbose

If this Boolean option is asserted, files that have no violations are
displayed as C<'OK'>. If not, files having no violations produce no
output.

=head2 --version

This option displays the version of this script. The script then exits.

=head1 DESCRIPTION

This Perl script wraps the rogue Perl::Critic policy
Variables::ProhibitUnusedVarsStricter. This is a variant of
Variables::ProhibitUnusedVariables that actually has some teeth.

If no arguments are passed, the contents of the F<MANIFEST> are scanned
-- at least, those which appear to be Perl files.

If an argument is passed which is not a file name, it is assumed to be
code to critique.

=head1 AUTHOR

Thomas R. Wyant, III F<harryfmudd at comcast dot net>

=head1 COPYRIGHT

Copyright (C) 2012-2022, 2024-2026 by Thomas R. Wyant, III

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the files F<LICENSE-Artistic> and F<LICENSE-GPL>.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 72
#   indent-tabs-mode: nil
#   c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=72 ft=perl expandtab shiftround :
