1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
5# This software is Copyright (c) 1996-2021 Best Practical Solutions, LLC
6#                                          <sales@bestpractical.com>
7#
8# (Except where explicitly superseded by other copyright notices)
9#
10#
11# LICENSE:
12#
13# This work is made available to you under the terms of Version 2 of
14# the GNU General Public License. A copy of that license should have
15# been provided with this software, but in any event can be snarfed
16# from www.gnu.org.
17#
18# This work is distributed in the hope that it will be useful, but
19# WITHOUT ANY WARRANTY; without even the implied warranty of
20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21# General Public License for more details.
22#
23# You should have received a copy of the GNU General Public License
24# along with this program; if not, write to the Free Software
25# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26# 02110-1301 or visit their web page on the internet at
27# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
28#
29#
30# CONTRIBUTION SUBMISSION POLICY:
31#
32# (The following paragraph is not intended to limit the rights granted
33# to you to modify and distribute this software under the terms of
34# the GNU General Public License and is only of importance to you if
35# you choose to contribute your changes and enhancements to the
36# community by submitting them to Best Practical Solutions, LLC.)
37#
38# By intentionally submitting any modifications, corrections or
39# derivatives to this work, or any other work intended for use with
40# Request Tracker, to Best Practical Solutions, LLC, you confirm that
41# you are the copyright holder for those contributions and you grant
42# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
43# royalty-free, perpetual, license to use, copy, create derivative
44# works based on those contributions, and sublicense and distribute
45# those contributions and any derivatives thereof.
46#
47# END BPS TAGGED BLOCK }}}
48
49package RT::Shredder::POD;
50
51use strict;
52use warnings;
53use Pod::Select;
54use Pod::PlainText;
55
56sub plugin_html
57{
58    my ($file, $out_fh) = @_;
59    my $parser = RT::Shredder::POD::HTML->new;
60    $parser->select('SYNOPSIS', 'ARGUMENTS', 'USAGE');
61    $parser->parse_from_file( $file, $out_fh );
62    return;
63}
64
65sub plugin_cli
66{
67    my ($file, $out_fh, $no_name) = @_;
68    local @Pod::PlainText::ISA = ('Pod::Select', @Pod::PlainText::ISA);
69    my $parser = Pod::PlainText->new();
70    $parser->select('SYNOPSIS', 'ARGUMENTS', 'USAGE');
71    $parser->add_selection('NAME') unless $no_name;
72    $parser->parse_from_file( $file, $out_fh );
73    return;
74}
75
76sub shredder_cli
77{
78    my ($file, $out_fh) = @_;
79    local @Pod::PlainText::ISA = ('Pod::Select', @Pod::PlainText::ISA);
80    my $parser = Pod::PlainText->new();
81    $parser->select('NAME', 'SYNOPSIS', 'USAGE', 'OPTIONS');
82    $parser->parse_from_file( $file, $out_fh );
83    return;
84}
85
86# Extract the help foer each argument from the plugin POD
87# they must be on a =head2 line in the ARGUMENTS section of the POD
88# the return value is a hashref:
89#   keys are the argument names,
90#   values are hash_refs: { name => <ucfirst argument name>,
91#                           type => <from the head line>,
92#                           help => <first paragraph from the POD>
93#                         }
94sub arguments_help {
95    my ($file) = @_;
96
97    my $text;
98    open( my $io_handle, ">:scalar", \$text )
99        or die "Can't open scalar for write: $!";
100    my $parser = RT::Shredder::POD::HTML->new;
101    $parser->select('ARGUMENTS');
102    $parser->parse_from_file( $file, $io_handle );
103
104    my $arguments_help = {};
105
106    while( $text=~ m{<h4[^>]*>    # argument description starts with an h4 title
107                       \s*(\S*)   #   argument name ($1)
108                         \s*-\s*
109                       ([^<]*)    #   argument type ($2)
110                     </h4>\s*
111                       (?:<p[^>]*>\s*
112                       (.*?)      #   help: the first paragraph of the POD     ($3)
113                     (?=</p>)
114                       )?
115                    }gsx
116          ) {
117        my( $arg, $arg_name, $type, $help)= ( lc( $1), $1, $2, $3 || '');
118        $arguments_help->{$arg}= { name => $arg_name, type => $type, help => $help };
119    }
120
121    return $arguments_help;
122}
123
1241;
125
126package RT::Shredder::POD::HTML;
127use base qw(Pod::Select);
128
129sub command
130{
131    my( $self, $command, $paragraph, $line_num ) = @_;
132
133    my $tag;
134    # =head1 => h3, =head2 => h4
135    if ($command =~ /^head(\d+)$/) {
136        my $h_level = $1 + 2;
137        $tag = "h$h_level";
138    }
139    my $out_fh = $self->output_handle();
140    my $expansion = $self->interpolate($paragraph, $line_num);
141    $expansion =~ s/^\s+|\s+$//;
142    $expansion = lc( $expansion );
143    $expansion = ucfirst( $expansion );
144
145    print $out_fh "<$tag class=\"rt-general-header1\">" if $tag eq 'h3';
146    print $out_fh "<$tag class=\"rt-general-header2\">" if $tag eq 'h4';
147    print $out_fh $expansion;
148    print $out_fh "</$tag>" if $tag;
149    print $out_fh "\n";
150    return;
151}
152
153sub verbatim
154{
155    my ($self, $paragraph, $line_num) = @_;
156    my $out_fh = $self->output_handle();
157    print $out_fh "<pre class=\"rt-general-paragraph\">";
158    print $out_fh $paragraph;
159    print $out_fh "</pre>";
160    print $out_fh "\n";
161    return;
162}
163
164sub textblock {
165    my ($self, $paragraph, $line_num) = @_;
166    my $out_fh = $self->output_handle();
167    my $expansion = $self->interpolate($paragraph, $line_num);
168    $expansion =~ s/^\s+|\s+$//;
169    print $out_fh "<p class=\"rt-general-paragraph\">";
170    print $out_fh $expansion;
171    print $out_fh "</p>";
172    print $out_fh "\n";
173    return;
174}
175
176sub interior_sequence {
177    my ($self, $seq_command, $seq_argument) = @_;
178    ## Expand an interior sequence; sample actions might be:
179    return "<b>$seq_argument</b>" if $seq_command eq 'B';
180    return "<i>$seq_argument</i>" if $seq_command eq 'I';
181    return "<tt>$seq_argument</tt>" if $seq_command eq 'C';
182    return "<span class=\"pod-sequence-$seq_command\">$seq_argument</span>";
183}
1841;
185