package App::Perlanalyst;

=head1 NAME

App::Perlanalyst -- main package for the perlanalyst tool

=head1 DESCRIPTION

This package implements the class App::Perlanalyst which acts like
a driver for everything else.

=cut

use strict;
use warnings;

use Cwd;
use English qw( -no_match_vars );    # Avoids regex performance penalty
use Getopt::Long;
use IO::Interactive qw(is_interactive);
use Module::Runtime qw(use_module);
use Module::List qw(list_modules);
use Term::ANSIColor qw(colored);

use Perl::Analysis::Static::Document;
use Perl::Analysis::Static::Question;
use Perl::Analysis::Static::Files;

our $VERSION='0.002';
our $COPYRIGHT='Copyright 2011 Gregor Goldbach.';

=head2 new

The C<new> constructor is quite trivial at this point, and is provided
merely as a convenience. You don't really need to think about this.

=cut

sub new {
    return bless {}, shift;
}

# TODO: rc-file
sub process_args {
    my ( $self, @args ) = @_;

    {

        # Getopt::Long processes ARGV
        local @ARGV = @args;
        Getopt::Long::Configure(qw(no_ignore_case bundling pass_through));

        # Don't add coderefs to GetOptions
        GetOptions(
            'a|analysis|all=s'       => \$self->{analysis},
            'f|filter=s'             => \@{ $self->{filter} },
            'h|help|?'               => \$self->{show_help},
            'man'                    => sub {
                                          require Pod::Usage;
                                          Pod::Usage::pod2usage({-verbose => 2});
                                          exit;
                                        },
            'q|question=s'           => \$self->{question},
            'Q|question-arguments=s' => \$self->{question_arguments},
            'v|verbose!'             => \$self->{verbose},
            'list-analyses!'         => \$self->{list_analyses},
            'list-filters!'   => \$self->{list_filters},
            'list-questions!' => \$self->{list_questions},
            'version' => \$self->{show_version}
        ) or App::Perlanalyst::die('Unable to parse options');

        # Stash the remainder of argv for later
        $self->{argv} = [@ARGV];
    }
}

sub run {
    my ($self) = @_;

    return show_version() if $self->{show_version};
    return show_help() if $self->{show_help};

    return $self->_list_analyses() if $self->{list_analyses};
    return $self->_list_filters() if $self->{list_filters};
    return $self->_list_questions() if $self->{list_questions};

    if ( $self->{analysis} ) {
        return $self->analyse() if $self->{analysis};
    }

    # ask questions if specified
    if ( $self->{question} ) {
        my $answer = $self->_ask_question( $self->_files() );
        return $self->_print_answer($answer);
    }

    # there is neither an analysis or a question ...
    return show_help();


}

# stolen from von App::Ack
sub die {
    my $program = File::Basename::basename($0);
    return CORE::die( $program, ': ', @_, "\n" );
}

sub analyse {
    my ($self) = @_;

    my $element_class = $self->{analysis};

    # preprend Perl::Analysis::Static::Element
    $element_class = 'Perl::Analysis::Static::Element::' . $element_class;

    my @filters;
    my @arguments;
    for my $filter (@{$self->{filter}}) {
        # split filter and arguments
        my ($f, $args)=split(/=/, $filter);

        push @filters, $f;
        push @arguments, $args;
    }

    my $question = Perl::Analysis::Static::Question->new(
      class => $element_class,
      filter => \@filters,
      arguments => \@arguments);
    my $answer = $question->ask( $self->_files );

    return $self->_print_answer($answer);
}

=head2 show_help()

Dumps the help page to the user.

=cut

sub show_help {
    print( <<"END_OF_HELP" );
Usage: perlanalyst [OPTION]... [FILES]...

Analyse your Perl documents in the tree from the current directory on down.
If [FILES] is specified, then only those files/directories are checked.

Examples: perlanalyst --all Sub

Analyses:
  --analysis            Specify what analysis to run.
  --list-analyses       List all analyses that may be run.
Filtering:
  --filter              Specify what filter to run on the list of elements found.
                        May be specified more than once.
                        Arguments to the filter may be given after an equal sign.
                        (e.g. --filter Name=foo)
  --list-filters        List all filters that may be used.

Questions:
  --question            Specify what question to ask.
                        Arguments to the question may be given after an equal sign.
                        (e.g. --question Sub::Name=foo)
  --list-questions      List all questions that may be called.

Miscellaneous:
  --help                This help
  --man                 man page
  --version             Display version & copyright

This is version $VERSION of the perlanalyst.
END_OF_HELP
    return;
}

=head2 _files (	)

=cut

sub _files {
    my ($self) = @_;
    my @files;

    $self->{argv} = [ getcwd() ] unless @{ $self->{argv} };

    # use map?
    for my $arg ( @{ $self->{argv} } ) {

        # is it a file?
        if ( -f $arg ) {
            push @files, $arg;
            next;
        }

        # is it a directory?
        if ( -d $arg ) {
            push @files, Perl::Analysis::Static::Files::files($arg);
            next;
        }
        App::Perlanalyst::die "'$arg' is neither file nor directory";
    }
    return \@files;
}

=head2 _display_filename ($filename)

=cut

sub _display_filename {
    my ( $self, $filename ) = @_;

    # remove cwd from the file to make it shorter and readable
    my $cwd = getcwd();
    $filename =~ s{$cwd}{.};

    # colour it if called interactive so we don't get the ANSI sequences
    # if the results are piped
    return colored( $filename, 'bold blue' ) if is_interactive;
    return $filename;
}

sub _display_elements_for_file {
    my ( $self, $elements, $filename ) = @_;
    print $self->_display_filename($filename) . ':' . "\n";

    for my $element (@$elements) {
        print $element->stringify() . "\n";
    }
}

=head2 _ask_question ()

=cut

sub _ask_question {
    my ($self) = @_;

    my $q = $self->{question};
    my ($question_class, $args)=split(/=/, $q);

    # preprend Perl::Analysis::Static::Question$question_class =
    $question_class='Perl::Analysis::Static::Question::' . $question_class;

    # load the question's module
    use_module($question_class);

    # create instance and set its arguments
    my $question = $question_class->new();
    $question->set_arguments($args);

    return $question->ask( $self->_files() );
}

=head2 _print_answer ($answer)

=cut

sub _print_answer {
    my ( $self, $answer ) = @_;

    return 1 unless $answer;

    for my $filename ( sort keys %$answer ) {
        my $elements = $answer->{$filename};
        $self->_display_elements_for_file( $elements, $filename );
    }
    return 1;
}

=head2 _list_modules ($kind, $name)


=cut

sub _list_modules {
    my ( $self, $kind, $name ) = @_;

    # build the module stem for that kind of modules
    my $stem = 'Perl::Analysis::Static::' . $kind . '::';
    my $modules = list_modules( $stem, { list_modules => 1, recurse => 1 } );

    # the keys are the names, sort them for convenience
    my @modules = sort keys %$modules;

    # remove the stem so the name is readable
    my @result = map { $_ =~ s{$stem}{}; $_ } @modules;

    # print them with a simple loop
    print "These are the available $name:\n";
    for my $module (@result) {
        print $module. "\n";
    }

    return 1;
}

=head2 _list_filters ()


=cut

sub _list_filters {
    my ($self) = @_;

    return $self->_list_modules( 'Filter', 'filters' );
}

=head2 _list_analyses ()


=cut

sub _list_analyses {
    my ($self) = @_;

    return $self->_list_modules( 'Analysis', 'analyses' );
}

=head2 _list_questions ()


=cut

sub _list_questions {
    my ($self) = @_;

    return $self->_list_modules( 'Question', 'questions' );
}

# stolen from App::Ack's get_version_statement
=head2 show_version

Returns the version information for perlanalyst.

=cut

sub show_version {
    require Config;

    my $copyright = $COPYRIGHT;
    my $this_perl = $Config::Config{perlpath};
    if ($^O ne 'VMS') {
        my $ext = $Config::Config{_exe};
        $this_perl .= $ext unless $this_perl =~ m/$ext$/i;
    }
    my $ver = sprintf( '%vd', $^V );

    print <<"END_OF_VERSION";
perlanalyst $VERSION
Running under Perl $ver at $this_perl

$copyright

This program is free software; you can redistribute it and/or modify it
under the terms of the Artistic License v2.0.
END_OF_VERSION
}

=head1 AUTHOR

Gregor Goldbach, glauschwuffel@nomaden.org

=head1 COPYRIGHT & LICENSE

Copyright 2011 Gregor Goldbach

This program is free software; you can redistribute it and/or modify it
under the terms of the Artistic License v2.0.

=cut

1;