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