lib/CatalystX/HelpText/Script/SearchUndocumentedHelpText.pm

   1 package CatalystX::HelpText::Script::SearchUndocumentedHelpText;
   2 use Moose;
   3 use Moose::Autobox;
   4 use MooseX::Types::Path::Class qw/ Dir /;
   5 use MooseX::Types::Moose qw/Str Undef HashRef ArrayRef Bool/;
   6 use File::Find;
   7 use Data::Dumper;
   8 use Getopt::Long::Descriptive; # Force GLD as we override bits..
   9 use MooseX::Types::LoadableClass qw/ LoadableClass /;
  10 use Template;
  11 use List::MoreUtils qw/ uniq /;
  12 use namespace::autoclean;
  13
  14 has finder_class => (
  15     isa => LoadableClass,
  16     coerce => 1,
  17     default => 'CatalystX::HelpText::Finder::TemplateToolkit',
  18     handles => {
  19         find_helptext_keys_in_fn => 'find_helptext_keys_in_fn',
  20     }
  21 );
  22
  23 has help_files_path => (
  24     is => 'ro',
  25     isa => Dir,
  26     coerce => 1,
  27     required => 1,
  28     handles => {
  29         _get_file => 'file',
  30     }
  31 );
  32
  33 has template_search_dir => (
  34     is => 'ro',
  35     isa => Str,
  36     default => './',
  37 );
  38
  39 has filename_pattern => (
  40     is => 'ro',
  41     isa => Str,
  42     default => '\.(html|tt)$',
  43 );
  44
  45 has help_files_ext => (
  46     is => 'ro',
  47     isa => Str|Undef,
  48     default => 'html',
  49 );
  50
  51 sub run {
  52     my ($self) = @_;
  53     $self->print_result();
  54 }
  55
  56 has all_keys => (
  57     is => 'ro',
  58     isa => ArrayRef[Str],
  59     lazy => 1,
  60     builder => '_build_all_keys',
  61 );
  62
  63 sub _build_all_keys {
  64     my $self = shift;
  65     [ uniq map { $self->_find_helptext_keys_in_fn($_)->flatten } $self->all_files->flatten ];
  66 }
  67
  68 has keys_to_helptext_exist_map => (
  69     isa => HashRef[Bool],
  70     lazy => 1,
  71     builder => '_build_keys_to_helptext_exist_map',
  72     traits => ['Hash'],
  73     handles => {
  74         does_helptext_exist_for_key => 'get',
  75     },
  76 );
  77
  78 sub _build_keys_to_helptext_exist_map {
  79     my $self = shift;
  80     return {
  81         map { $_ => $self->_helptext_file_for_key_exists($_) }
  82         $self->all_keys->flatten
  83     };
  84 }
  85
  86
  87 has documented_keys => (
  88     isa => ArrayRef[Str],
  89     is => 'ro',
  90     lazy => 1,
  91     default => sub {
  92         my $self = shift;
  93         [ grep { $self->does_helptext_exist_for_key($_) } $self->all_keys->flatten ];
  94     },
  95     traits => ['Array'],
  96     handles => {
  97         has_documented_keys => 'count',
  98     },
  99 );
 100
 101 has undocumented_keys => (
 102     isa => ArrayRef[Str],
 103     is => 'ro',
 104     lazy => 1,
 105     default => sub {
 106         my $self = shift;
 107         [ grep { ! $self->does_helptext_exist_for_key($_) } $self->all_keys->flatten ];
 108     },
 109     traits => ['Array'],
 110     handles => {
 111         has_undocumented_keys => 'count',
 112     },
 113 );
 114
 115 has all_files => (
 116     isa => ArrayRef[Str],
 117     is => 'ro',
 118     lazy => 1,
 119     builder => '_build_all_files',
 120 );
 121
 122 sub _build_all_files {
 123     my ($self) = @_;
 124     my $filename_pattern = $self->filename_pattern;
 125     my @files = ();
 126     find(
 127         {
 128             wanted => sub {
 129                 my $filename = $File::Find::name;
 130                 return unless -f $filename;
 131                 return unless $filename =~ /$filename_pattern/;
 132                 push @files, $filename;
 133             },
 134             bydepth => 1
 135         }, $self->template_search_dir->flatten);
 136     return [ @files ];
 137 }
 138
 139 sub _find_helptext_keys_in_fn {
 140     my ($self, $fn) = @_;
 141     return $self->find_helptext_keys_in_fn($fn, $self);
 142 }
 143
 144 sub _helptext_file_for_key_exists {
 145     my ($self, $key) = @_;
 146     my $file = $self->_get_file($key);
 147     $file .= "." . $self->help_files_ext if defined($self->help_files_ext);
 148     return (-e $file);
 149 }
 150
 151 sub print_result {
 152     my ($self) = @_;
 153     if ($self->has_undocumented_keys) {
 154         print "Undocumented help text keys: \n";
 155         print " - $_\n" for ($self->undocumented_keys->flatten);
 156     }
 157 }
 158
 159 with qw/
 160     MooseX::Getopt
 161 /;
 162
 163 __PACKAGE__->meta->make_immutable;
 164 __PACKAGE__->new_with_options->run unless caller;
 165
 166 1;
 167
 168 =head1 NAME
 169
 170 CatalystX::HelpText::Script::SearchUndocumentedHelpText
 171
 172 =head1 SYNOPSIS
 173
 174     search_undocumented_templates.pl
 175
 176 =head1 SEE ALSO
 177
 178 =over
 179
 180 =item L<CatalystX::HelpText>
 181
 182 =back
 183
 184 =head1 AUTHOR
 185
 186 Toomas Doran, C<< t0m at state51.co.uk >>
 187
 188 Cinxgler Mariaca Minda, C<< cinxgler at ci-info.com >>
 189
 190 =head1 COPYRIGHT
 191
 192 Copyright Oscar Music and Media 2011.
 193
 194 =head1 LICENSE
 195
 196 This sofware is free software, and is licensed under the same terms as perl itself.
 197
 198 =cut
 199