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