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/;
   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 Capture::Tiny qw/capture/;
  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     my $file_vs_keys = {};
  45     my $undocumented_keys = {};
  46     foreach my $fn ($self->find_files->flatten) {
  47         $file_vs_keys->{$fn} = $self->find_helptext_keys($fn);
  48         foreach my $key ($file_vs_keys->{$fn}->flatten) {
  49             unless ($self->is_there_helptext_file_for_key($key)) {
  50                 $undocumented_keys->{$key} = 1;
  51             }
  52         }
  53     }
  54     $self->print_result([ keys %$undocumented_keys ], $file_vs_keys);
  55 }
  56
  57 sub find_files {
  58     my ($self) = @_;
  59     my $filename_pattern = $self->filename_pattern;
  60     my @files = ();
  61     find(
  62         {
  63             wanted => sub {
  64                 my $filename = $File::Find::name;
  65                 return unless -f $filename;
  66                 return unless $filename =~ /$filename_pattern/;
  67                 push @files, $filename;
  68             },
  69             bydepth => 1
  70         }, $self->template_search_dir->flatten);
  71     return [ @files ];
  72 }
  73
  74 sub find_helptext_keys {
  75     my ($self, $fn) = @_;
  76     my $dir = $self->template_search_dir;
  77     my @keys = ();
  78     my $t = Template->new({
  79         INCLUDE_PATH => [ $self->template_search_dir ],
  80         ABSOLUTE => 1,
  81     });
  82     my ($stdout, $stderr) = capture {
  83         $t->process($fn, {  help_text => sub { push @keys, shift } });
  84     };
  85     return [ @keys ];
  86 }
  87
  88 sub is_there_helptext_file_for_key {
  89     my ($self, $key) = @_;
  90     my $file = $self->_get_file($key);
  91     $file .= "." . $self->help_files_ext if defined($self->help_files_ext);
  92     return (-e $file);
  93 }
  94
  95 sub print_result {
  96     my ($self, $undocumented_keys, $file_vs_keys) = @_;
  97     if (scalar @$undocumented_keys) {
  98         print "Undocumented help text keys: \n";
  99         print " - $_" for ($undocumented_keys->flatten);
 100     }
 101 }
 102
 103 with qw/
 104     MooseX::Getopt
 105 /;
 106
 107 __PACKAGE__->meta->make_immutable;
 108 __PACKAGE__->new_with_options->run unless caller;
 109
 110 1;
 111
 112 =head1 NAME
 113
 114 CatalystX::HelpText::Script::SearchUndocumentedHelpText
 115
 116 =head1 SYNOPSIS
 117
 118     search_undocumented_templates.pl
 119
 120 =head1 SEE ALSO
 121
 122 =over
 123
 124 =item L<CatalystX::HelpText>
 125
 126 =back
 127
 128 =head1 AUTHOR
 129
 130 Toomas Doran, C<< t0m at state51.co.uk >>
 131
 132 Cinxgler Mariaca Minda, C<< cinxgler at ci-info.com >>
 133
 134 =head1 COPYRIGHT
 135
 136 Copyright Oscar Music and Media 2011.
 137
 138 =head1 LICENSE
 139
 140 This sofware is free software, and is licensed under the same terms as perl itself.
 141
 142 =cut
 143