The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Perl::Analysis::Static::Questioner;
{
  $Perl::Analysis::Static::Questioner::VERSION = '0.004'; # TRIAL
}

# ABSTRACT: ask a question about a Perl document


use Moose;
use Carp;
use English qw( -no_match_vars );    # Avoids regex performance penalty

use Module::Runtime qw(use_module);

use Perl::Analysis::Static::Document;
use Perl::Analysis::Static::Answer;
use Perl::Analysis::Static::Collector;


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

    my $document =
        Perl::Analysis::Static::Document->new( filename => $filename );
    unless ($document) {
        App::Perlanalyst::die(
            "Unable to get document instance for file '$filename'");
    }

    return $self->ask_for_document( $question, $document );
}


sub ask_for_document {
    my ( $self, $question, $document ) = @_;

    unless ($document) {
        App::Perlanalyst::die('Argument error: need document');
    }

    # find all elements of this class
    my $elements = $document->find( $question->class() );

    # return if we didn't find anything
    return unless $elements;

    # filter the elements if we have to
    $elements = $self->_filter( $question, $elements ) if $question->{filter};

    # return immediately if we filtered everything
    return unless $elements;

    my $answer = Perl::Analysis::Static::Answer->new( elements => $elements );
    return $answer;
}


sub ask_for_files {
    my ( $self, $question, $files, $step_hook ) = @_;

    my $collector = Perl::Analysis::Static::Collector->new();

    for my $file (@$files) {
        my $answer =
            $self->ask_for_file( $question, $file );
        $collector->set_answer( $file, $answer ) if $answer;
        &$step_hook($file) if $step_hook and ref $step_hook eq 'CODE';
    }
    
    return $collector;
}


sub _filter {
    my ( $self, $question, $elements ) = @_;

    my @filters   = @{ $question->filter };
    my @arguments = @{ $question->arguments };

    for my $filter_class (@filters) {

        # preprend Perl::Analysis::Static::Filter if it's not already there
        unless ( $filter_class =~ m{^Perl::Analysis::Static::Filter::} ) {
            $filter_class = 'Perl::Analysis::Static::Filter::' . $filter_class;
        }

        # load the filter's module
        use_module($filter_class);

        # create instance and set its arguments
        my $filter    = $filter_class->new();
        my $arguments = shift @arguments;
        $filter->set_arguments($arguments);

        # filter the elements
        $elements = $filter->filter($elements);

    }
    return $elements;
}

1;

__END__
=pod

=head1 NAME

Perl::Analysis::Static::Questioner - ask a question about a Perl document

=head1 VERSION

version 0.004

=head2 DESCRIPTION

=head2 ask_for_file ($question, $filename)

=head2 ask_for_document ($question, $document)

Asks the question for a document.

If we didn't find any elements, we return immediately with undef.
Hoewever, if we have found something, we run our filters over
it. We return the result of the filters which might be a reference
to a list of elements. If we filtered everything and nothing is left,
we return undef.

=head2 ask_for_files ($question, $files, ;$step_hook)

Asks a question for a list of files and collects the answers.

The $step_hook is optional. If provided, it is called with the
file's name as only argument after the answer for that file is added
to the collector.

Results: A collector containing all the answers.

Example:
  my $collector = $questioner->ask_for_files( $question, $files,
                     sub { print shift } );

=head2 INTERNAL METHODS

=head2 _filter ($question, $elements)

=head1 AUTHOR

Gregor Goldbach <glauschwuffel@nomaden.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Gregor Goldbach.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut