1# Copyright (C) 2008-2011, Parrot Foundation.
2
3package Parrot::SearchOps;
4
5use strict;
6use warnings;
7use lib qw(lib);
8
9use Exporter;
10use Text::Wrap;
11
12use Parrot::Configure::Utils qw(_slurp);
13
14our @ISA       = qw(Exporter);
15our @EXPORT_OK = qw(
16    search_all_ops_files
17    help
18    usage
19);
20
21sub search_all_ops_files {
22    my ($pattern, $wrap_width, $opsdir) = @_;
23    $Text::Wrap::columns = $wrap_width;
24    my @opsfiles = glob("$opsdir/*.ops");
25
26    my $total_identified = 0;
27    foreach my $f (@opsfiles) {
28        $total_identified = _search_one_ops_file(
29            $pattern, $wrap_width, $total_identified, $f,
30        );
31    }
32    return $total_identified;
33}
34
35sub _search_one_ops_file {
36    my ($pattern, $wrap_width, $total_identified, $f) = @_;
37    my $fullpattern = qr/^=item\sB<(\w*$pattern\w*)>\(([^)]*)\)/;
38    my @paras = split /\n{2,}/, _slurp($f);
39    my %iden_paras = ();
40    for (my $i=0; $i<=$#paras; $i++) {
41        my $j = $i+1;
42        if ( $paras[$i] =~ /$fullpattern/ and $paras[$j]) {
43            $iden_paras{$i}{op} = $1;
44            $iden_paras{$i}{args} = $2;
45        }
46    }
47    if (keys %iden_paras) {
48        my @keys = keys %iden_paras;
49        my $seen = scalar @keys;
50        $total_identified += $seen;
51        _print_name(\@paras, $wrap_width, $seen);
52        my @sorted_idx = sort {$a <=> $b} @keys;
53        my %remain_paras = map {$_, 1} @keys;
54        foreach my $idx (@sorted_idx) {
55            if ($remain_paras{$idx}) {
56                my $k = _handle_indices(
57                    \%iden_paras,
58                    $idx,
59                    \%remain_paras,
60                );
61                print fill('', '', ($paras[$k])), "\n\n";
62            }
63        }
64    }
65    return $total_identified;
66}
67
68sub _print_name {
69    my $parasref = shift;
70    my $wrap_width = shift;
71    my $count = shift;
72    NAME: for (my $i=0; $i<=$#$parasref; $i++) {
73        my $j = $i+1;
74        if ($parasref->[$i] =~ /^=head1\s+NAME/ and $parasref->[$j]) {
75            my $str = qq{\n};
76            $str .= q{-} x $wrap_width . qq{\n};
77            $str .= $parasref->[$j] .
78                q<  (> .
79                $count .
80                q< > .
81                ($count > 1 ?  q<matches> : q<match>) .
82                qq<)\n>;
83            $str .= q{-} x $wrap_width .  qq{\n};
84            $str .= qq{\n};
85            print $str;
86            last NAME;
87        }
88    }
89}
90
91sub _handle_indices {
92    my ($identified_ref, $idx, $remaining_ref) = @_;
93    my $j = $idx + 1;
94    my $k = $j;
95    print qq{$identified_ref->{$idx}{op}($identified_ref->{$idx}{args})\n};
96    delete $remaining_ref->{$idx};
97    if (defined $identified_ref->{$j}{op} ) {
98        $k = _handle_indices(
99            $identified_ref,
100            $j,
101            $remaining_ref,
102        );
103    }
104    return $k;
105}
106
107sub usage {
108    print <<USAGE;
109    perl tools/dev/search_ops.pl [--help] [--all] ops_pattern
110USAGE
111}
112
113sub help {
114    usage();
115    print <<HELP;
116
117Given a valid Perl 5 regex as an argument, the script will search inside any
118*.ops file for an opcode name that matches, dumping both its arguments and its
119description.  The program must be called from the top-level Parrot directory.
120To dump every op, call '--all' on the command line.
121
122Example:
123> perl tools/dev/search_ops.pl load
124
125----------------------------------------------------------------------
126File: core.ops - Parrot Core Ops (2 matches)
127----------------------------------------------------------------------
128
129load_bytecode(in STR)
130Load Parrot bytecode from file \$1, and (TODO) search the library path,
131to locate the file.
132
133loadlib(out PMC, in STR)
134Load a dynamic link library named \$2 and store it in \$1.
135
136----------------------------------------------------------------------
137File: debug.ops (1 match)
138----------------------------------------------------------------------
139
140debug_load(inconst STR)
141Load a Parrot source file for the current program.
142HELP
143}
144
1451;
146
147=head1 NAME
148
149Parrot::SearchOps - functions used in tools/dev/search_ops.pl
150
151=head1 SYNOPSIS
152
153    use Parrot::SearchOps qw(
154        search_all_ops_files
155        usage
156        help
157    );
158
159    $total_identified = search_all_ops_files(
160        $pattern, $wrap_width, $opsdir
161    );
162
163    usage();
164
165    help();
166
167=head1 DESCRIPTION
168
169This package provides functionality for the Perl 5 program
170F<tools/dev/search_ops.pl>, designed to replace the Python program
171F<tools/docs/search-ops.py>.  It exports two subroutines on demand.
172
173=head2 C<search_all_ops_files()>
174
175B<Purpose:>  Searches all F<.ops> files in F<src/ops/> for ops codes and their
176descriptions.  Those that match the specified pattern are printed to STDOUT.
177
178B<Arguments:>  Three scalars.
179
180=over 4
181
182=item * C<$pattern>
183
184Perl 5 regular expression.  So C<concat> will be matched by both C<concat> and
185C<n_concat>.
186
187=item * $wrap_width
188
189In F<tools/dev/search_ops.pl>, this is set to C<70> characters. Can be varied
190during testing or development.
191
192=item * $opsdir
193
194In F<tools/dev/search_ops.pl>, this is set to F<src/ops/>.  Can be varied
195during testing or development.
196
197=back
198
199B<Return Value:>  Number of times the pattern was matched by ops codes in all
200files.
201
202=head2 C<usage()>
203
204B<Purpose:>  Display usage statement for F<tools/dev/search_ops.pl>.
205
206B<Arguments:>  None.
207
208C<Return Value:>  Implicitly returns true upon success.
209
210=head2 C<help()>
211
212B<Purpose:>  Display usage statement and more complete help message for F<tools/dev/search_ops.pl>.
213
214B<Arguments:>  None.
215
216C<Return Value:>  Implicitly returns true upon success.
217
218=head1 AUTHOR
219
220James E Keenan, adapting Python program written by Bernhard Schmalhofer.
221
222=cut
223
224# Local Variables:
225#   mode: cperl
226#   cperl-indent-level: 4
227#   fill-column: 100
228# End:
229# vim: expandtab shiftwidth=4:
230