1package Pod::Readme::Plugin; 2 3use v5.10.1; 4 5use Moo::Role; 6 7our $VERSION = 'v1.2.3'; 8 9use Class::Method::Modifiers qw/ fresh /; 10use Hash::Util qw/ lock_keys /; 11use Try::Tiny; 12 13use Pod::Readme::Types qw/ Indentation /; 14 15=head1 NAME 16 17Pod::Readme::Plugin - Plugin role for Pod::Readme 18 19=head1 DESCRIPTION 20 21L<Pod::Readme> v1.0 and later supports plugins that extend the 22capabilities of the module. 23 24=head1 WRITING PLUGINS 25 26Writing plugins is straightforward. Plugins are L<Moo::Role> modules 27in the C<Pod::Readme::Plugin> namespace. For example, 28 29 package Pod::Readme::Plugin::myplugin; 30 31 use Moo::Role; 32 33 sub cmd_myplugin { 34 my ($self, @args) = @_; 35 my $res = $self->parse_cmd_args( [qw/ arg1 arg2 /], @args ); 36 37 ... 38 } 39 40When L<Pod::Readme> encounters POD with 41 42 =for readme plugin myplugin arg1 arg2 43 44the plugin role will be loaded, and the C<cmd_myplugin> method will be 45run. 46 47Note that you do not need to specify a C<cmd_myplugin> method. 48 49Any method prefixed with "cmd_" will be a command that can be called 50using the C<=for readme command> syntax. 51 52A plugin parses arguments using the L</parse_cmd_arguments> method and 53writes output using the write methods noted above. 54 55See some of the included plugins, such as 56L<Pod::Readme::Plugin::version> for examples. 57 58Any attributes in the plugin should be prefixed with the name of the 59plugin, to avoid any conflicts with attribute and method names from 60other plugins, e.g. 61 62 use Types::Standard qw/ Int /; 63 64 has 'myplugin_heading_level' => ( 65 is => 'rw', 66 isa => Int, 67 default => 1, 68 lazy => 1, 69 ); 70 71Attributes should be lazy to ensure that their defaults are properly 72set. 73 74Be aware that changing default values of an attribute based on 75arguments means that the next time a plugin method is run, the 76defaults will be changed. 77 78Custom types in L<Pod::Readme::Types> may be useful for attributes 79when writing plugins, e.g. 80 81 use Pod::Readme::Types qw/ File HeadingLevel /; 82 83 has 'myplugin_file' => ( 84 is => 'rw', 85 isa => File, 86 coerce => sub { File->coerce(@_) }, 87 default => 'Changes', 88 lazy => 1, 89 ); 90 91 # We add this file to the list of dependencies 92 93 around 'depends_on' => sub { 94 my ($orig, $self) = @_; 95 return ($self->myplugin_file, $self->$orig); 96 }; 97 98=head1 ATTRIBUTES 99 100=head2 C<verbatim_indent> 101 102The number of columns to indent a verbatim paragraph. 103 104=cut 105 106has verbatim_indent => ( 107 is => 'ro', 108 isa => Indentation, 109 default => 2, 110); 111 112=head1 METHODS 113 114=cut 115 116sub _parse_arguments { 117 my ( $self, $line ) = @_; 118 my @args = (); 119 120 my $i = 0; 121 my $prev; 122 my $in_quote = ''; 123 my $arg_buff = ''; 124 while ( $i < length($line) ) { 125 126 my $curr = substr( $line, $i, 1 ); 127 if ( $curr !~ m/\s/ || $in_quote ) { 128 $arg_buff .= $curr; 129 if ( $curr =~ /["']/ && $prev ne "\\" ) { 130 $in_quote = ( $curr eq $in_quote ) ? '' : $curr; 131 } 132 } 133 elsif ( $arg_buff ne '' ) { 134 push @args, $arg_buff; 135 $arg_buff = ''; 136 } 137 $prev = $curr; 138 $i++; 139 } 140 141 if ( $arg_buff ne '' ) { 142 push @args, $arg_buff; 143 } 144 145 return @args; 146} 147 148=head2 C<parse_cmd_args> 149 150 my $hash_ref = $self->parse_cmd_args( \@allowed_keys, @args); 151 152This command parses arguments for a plugin and returns a hash 153reference containing the argument values. 154 155The C<@args> parameter is a list of arguments passed to the command 156method by L<Pod::Readme::Filter>. 157 158If an argument contains an equals sign, then it is assumed to take a 159string. (Strings containing whitespace should be surrounded by 160quotes.) 161 162Otherwise, an argument is assumed to be boolean, which defaults to 163true. If the argument is prefixed by "no-" or "no_" then it is given a 164false value. 165 166If the C<@allowed_keys> parameter is given, then it will reject 167argument keys that are not in that list. 168 169For example, 170 171 my $res = $self->parse_cmd_args( 172 undef, 173 'arg1', 174 'no-arg2', 175 'arg3="This is a string"', 176 'arg4=value', 177 ); 178 179will return a hash reference containing 180 181 { 182 arg1 => 1, 183 arg2 => 0, 184 arg3 => 'This is a string', 185 arg4 => 'value', 186 } 187 188=cut 189 190sub parse_cmd_args { 191 my ( $self, $allowed, @args ) = @_; 192 193 my ( $key, $val, %res ); 194 while ( my $arg = shift @args ) { 195 196 state $eq = qr/=/; 197 198 if ( $arg =~ $eq ) { 199 ( $key, $val ) = split $eq, $arg; 200 201 # TODO - better way to remove surrounding quotes 202 if ( ( $val =~ /^(['"])(.*)(['"])$/ ) && ( $1 eq $3 ) ) { 203 $val = $2 // ''; 204 } 205 206 } 207 else { 208 $val = 1; 209 if ( ($key) = ( $arg =~ /^no[_-](\w+(?:[-_]\w+)*)$/ ) ) { 210 $val = 0; 211 } 212 else { 213 $key = $arg; 214 } 215 } 216 217 $res{$key} = $val; 218 } 219 220 if ($allowed) { 221 try { 222 lock_keys( %res, @{$allowed} ); 223 } 224 catch { 225 if (/Hash has key '(.+)' which is not in the new key set/) { 226 die sprintf( "Invalid argument key '\%s'\n", $1 ); 227 } 228 else { 229 die "Unknown error checking argument keys\n"; 230 } 231 }; 232 } 233 234 return \%res; 235} 236 237=head2 C<write_verbatim> 238 239 $self->write_verbatim($text); 240 241A utility method to write verbatim text, indented by 242L</verbatim_indent>. 243 244=cut 245 246sub write_verbatim { 247 my ( $self, $text ) = @_; 248 249 my $indent = ' ' x ( $self->verbatim_indent ); 250 $text =~ s/^/${indent}/mg; 251 $text =~ s/([^\n])\n?$/$1\n\n/; 252 253 $self->write($text); 254} 255 256=begin :internal 257 258=head2 C<_write_cmd> 259 260 $self->_write_cmd('=head1 SECTION'); 261 262An internal utility method to write a command line. 263 264=end :internal 265 266=cut 267 268sub _write_cmd { 269 my ( $self, $text ) = @_; 270 $text =~ s/([^\n])\n?$/$1\n\n/; 271 272 $self->write($text); 273} 274 275=head2 C<write_para> 276 277 $self->write_para('This is a paragraph'); 278 279Utility method to write a POD paragraph. 280 281=cut 282 283sub write_para { 284 my ( $self, $text ) = @_; 285 $text //= ''; 286 $self->write( $text . "\n\n" ); 287} 288 289=head2 C<write_head1> 290 291=head2 C<write_head2> 292 293=head2 C<write_head3> 294 295=head2 C<write_head4> 296 297=head2 C<write_over> 298 299=head2 C<write_item> 300 301=head2 C<write_back> 302 303=head2 C<write_begin> 304 305=head2 C<write_end> 306 307=head2 C<write_for> 308 309=head2 C<write_encoding> 310 311=head2 C<write_cut> 312 313=head2 C<write_pod> 314 315 $self->write_head1($text); 316 317Utility methods to write POD specific commands to the C<output_file>. 318 319These methods ensure the POD commands have extra newlines for 320compatibility with older POD parsers. 321 322=cut 323 324{ 325 foreach my $cmd ( 326 qw/ head1 head2 head3 head4 327 over item begin end for encoding / 328 ) 329 { 330 fresh( 331 "write_${cmd}" => sub { 332 my ( $self, $text ) = @_; 333 $text //= ''; 334 $self->_write_cmd( '=' . $cmd . ' ' . $text ); 335 } 336 ); 337 } 338 339 foreach my $cmd (qw/ pod back cut /) { 340 fresh( 341 "write_${cmd}" => sub { 342 my ($self) = @_; 343 $self->_write_cmd( '=' . $cmd ); 344 } 345 ); 346 } 347 348} 349 350use namespace::autoclean; 351 3521; 353