Allow you to spin this up without the script and get data out programatically more...

[catagits/CatalystX-HelpText.git] / lib / CatalystX / HelpText / Script / SearchUndocumentedHelpText.pm

package CatalystX::HelpText::Script::SearchUndocumentedHelpText;
use Moose;
use Moose::Autobox;
use MooseX::Types::Path::Class qw/ Dir /;
use MooseX::Types::Moose qw/Str Undef HashRef ArrayRef Bool/;
use File::Find;
use Data::Dumper;
use Getopt::Long::Descriptive; # Force GLD as we override bits..
use MooseX::Types::LoadableClass qw/ LoadableClass /;
use Template;
use List::MoreUtils qw/ uniq /;
use namespace::autoclean;

has help_files_path => (
    is => 'ro',
    isa => Dir,
    coerce => 1,
    required => 1,
    handles => {
        _get_file => 'file',
    }
);

has template_search_dir => (
    is => 'ro',
    isa => Str,
    default => './',
);

has filename_pattern => (
    is => 'ro',
    isa => Str,
    default => '\.(html|tt)$',
);

has help_files_ext => (
    is => 'ro',
    isa => Str|Undef,
    default => 'html',
);

sub run {
    my ($self) = @_;
    $self->print_result();
}

has all_keys => (
    is => 'ro',
    isa => ArrayRef[Str],
    lazy => 1,
    builder => '_build_all_keys',
);

sub _build_all_keys {
    my $self = shift;
    [ uniq map { $self->_find_helptext_keys_in_fn($_)->flatten } $self->all_files->flatten ];
}

has keys_to_helptext_exist_map => (
    isa => HashRef[Bool],
    lazy => 1,
    builder => '_build_keys_to_helptext_exist_map',
    traits => ['Hash'],
    handles => {
        does_helptext_exist_for_key => 'get',
    },
);

sub _build_keys_to_helptext_exist_map {
    my $self = shift;
    return {
        map { $_ => $self->_helptext_file_for_key_exists($_) }
        $self->all_keys->flatten
    };
}


has documented_keys => (
    isa => ArrayRef[Str],
    is => 'ro',
    lazy => 1,
    default => sub {
        my $self = shift;
        [ grep { $self->does_helptext_exist_for_key($_) } $self->all_keys->flatten ];
    },
    traits => ['Array'],
    handles => {
        has_documented_keys => 'count',
    },
);

has undocumented_keys => (
    isa => ArrayRef[Str],
    is => 'ro',
    lazy => 1,
    default => sub {
        my $self = shift;
        [ grep { ! $self->does_helptext_exist_for_key($_) } $self->all_keys->flatten ];
    },
    traits => ['Array'],
    handles => {
        has_undocumented_keys => 'count',
    },
);

has all_files => (
    isa => ArrayRef[Str],
    is => 'ro',
    lazy => 1,
    builder => '_build_all_files',
);

sub _build_all_files {
    my ($self) = @_;
    my $filename_pattern = $self->filename_pattern;
    my @files = ();
    find(
        {
            wanted => sub {
                my $filename = $File::Find::name;
                return unless -f $filename;
                return unless $filename =~ /$filename_pattern/;
                push @files, $filename;
            },
            bydepth => 1
        }, $self->template_search_dir->flatten);
    return [ @files ];
}

sub _find_helptext_keys_in_fn {
    my ($self, $fn) = @_;
    my $dir = $self->template_search_dir;
    my @keys = ();
    my $t = Template->new({
        INCLUDE_PATH => [ $self->template_search_dir ],
        ABSOLUTE => 1,
    });
    my $out;
    $t->process($fn, { help_text => sub { push @keys, shift } }, \$out);
    return [ uniq @keys ];
}

sub _helptext_file_for_key_exists {
    my ($self, $key) = @_;
    my $file = $self->_get_file($key);
    $file .= "." . $self->help_files_ext if defined($self->help_files_ext);
    return (-e $file);
}

sub print_result {
    my ($self) = @_;
    if ($self->has_undocumented_keys) {
        print "Undocumented help text keys: \n";
        print " - $_\n" for ($self->undocumented_keys->flatten);
    }
}

with qw/
    MooseX::Getopt
/;

__PACKAGE__->meta->make_immutable;
__PACKAGE__->new_with_options->run unless caller;

1;

=head1 NAME

CatalystX::HelpText::Script::SearchUndocumentedHelpText

=head1 SYNOPSIS

    search_undocumented_templates.pl

=head1 SEE ALSO

=over

=item L<CatalystX::HelpText>

=back

=head1 AUTHOR

Toomas Doran, C<< t0m at state51.co.uk >>

Cinxgler Mariaca Minda, C<< cinxgler at ci-info.com >>

=head1 COPYRIGHT

Copyright Oscar Music and Media 2011.

=head1 LICENSE

This sofware is free software, and is licensed under the same terms as perl itself.

=cut