#!/usr/bin/perl use strict; use warnings; use RPerl; our $VERSION = 0.011_000; # wget https://perldoc.perl.org/perlapi.html use List::MoreUtils qw(uniq); use English qw(-no_match_vars); use Data::Dumper; $Data::Dumper::Sortkeys = 1; ## no critic qw(ProhibitExplicitStdin) # USER DEFAULT 4: allow <STDIN> print 'ARE YOU AN RPERL SYSTEM DEVELOPER? '; my $stdin_confirm = <STDIN>; if ( $stdin_confirm =~ /^[Yy]/ ) { print 'Regenerating Perl API Names...' . "\n"; } else { exit; } my $perlapinames_filename = 'lib/perlapinames_generated.pm'; # generate static output my $perlapinames_generated = <<'EOF'; # THIS FILE IS AUTOMATICALLY GENERATED BY script/development/perlapinames_regenerate.pl # DO NOT EDIT THIS FILE DIRECTLY!!! please put all changes in perlapinames_regenerate.pl ## no critic qw(Capitalization ProhibitMultiplePackages ProhibitReusedNames) # SYSTEM DEFAULT 3: allow multiple & lower case package names package # hide from PAUSE indexing perlapinames_generated; use strict; use warnings; our $VERSION = 0.001_000; ## no critic qw(ProhibitParensWithBuiltins ProhibitNoisyQuotes) # SYSTEM SPECIAL 3: allow auto-generated code EOF # read & parse input file my string $input_filename = $ARGV[0]; print 'have input $input_filename = ', $input_filename, "\n"; my string_arrayref $perl_functions_documented = []; my string_arrayref $perl_functions_undocumented = []; my string_arrayref $perl_variables_documented = []; my string_arrayref $perl_variables_undocumented = []; my boolean $documented = 1; # read file open my filehandleref $FILE_HANDLE, '<', $input_filename or croak 'ERROR, Cannot open file ' . $input_filename . ' for reading,' . $OS_ERROR . ', croaking'; while ( my $input_line = <$FILE_HANDLE> ) { # print 'have $input_line = ', $input_line, "\n"; # HARD-CODED EXAMPLE: #<li><a name="sv_pvn_nomg"></a><b>sv_pvn_nomg if ($documented) { if ($input_line eq '<a name="Undocumented-functions"></a><h1>Undocumented functions</h1>' . "\n") { $documented = 0; } if ($input_line =~ m/^<li><a\ name="\w+"><\/a><b>(\w+)$/gxms) { push @{$perl_functions_documented}, $1; if (((substr $1, 0, 4) eq 'get_') or ((substr $1, 0, 4) eq 'set_')) { push @{$perl_variables_documented}, (substr $1, 4); } } } else { if ($input_line =~ m/^<li><a\ name="\w+"><\/a><b>(\w+)$/gxms) { push @{$perl_functions_undocumented}, $1; if (((substr $1, 0, 4) eq 'get_') or ((substr $1, 0, 4) eq 'set_')) { push @{$perl_variables_undocumented}, (substr $1, 4); } } } } close $FILE_HANDLE or croak 'ERROR, Cannot close file ' . $input_filename . ' after reading,' . $OS_ERROR . ', croaking'; # generate dynamic output $perlapinames_generated .= '$perlapinames_generated::FUNCTIONS_DOCUMENTED = undef;' . "\n"; $perlapinames_generated .= '$perlapinames_generated::FUNCTIONS_DOCUMENTED = {' . "\n"; foreach my string $perl_function_documented (uniq sort @{$perl_functions_documented}) { $perlapinames_generated .= q{ '} . $perl_function_documented . q{' => 1,} . "\n"; } $perlapinames_generated .= '};' . "\n\n"; $perlapinames_generated .= '$perlapinames_generated::FUNCTIONS_UNDOCUMENTED = undef;' . "\n"; $perlapinames_generated .= '$perlapinames_generated::FUNCTIONS_UNDOCUMENTED = {' . "\n"; foreach my string $perl_function_undocumented (uniq sort @{$perl_functions_undocumented}) { $perlapinames_generated .= q{ '} . $perl_function_undocumented . q{' => 1,} . "\n"; } $perlapinames_generated .= '};' . "\n\n"; $perlapinames_generated .= '$perlapinames_generated::VARIABLES_DOCUMENTED = undef;' . "\n"; $perlapinames_generated .= '$perlapinames_generated::VARIABLES_DOCUMENTED = {' . "\n"; foreach my string $perl_function_documented (uniq sort @{$perl_variables_documented}) { $perlapinames_generated .= q{ '} . $perl_function_documented . q{' => 1,} . "\n"; } $perlapinames_generated .= '};' . "\n\n"; $perlapinames_generated .= '$perlapinames_generated::VARIABLES_UNDOCUMENTED = undef;' . "\n"; $perlapinames_generated .= '$perlapinames_generated::VARIABLES_UNDOCUMENTED = {' . "\n"; foreach my string $perl_function_undocumented (uniq sort @{$perl_variables_undocumented}) { $perlapinames_generated .= q{ '} . $perl_function_undocumented . q{' => 1,} . "\n"; } $perlapinames_generated .= '};' . "\n\n"; # finish static output $perlapinames_generated .= '1; # end of package' . "\n"; # write output file my $open_close_retval = open my $PERLAPINAMES_FILEHANDLE_OUT, '>', $perlapinames_filename; if ( not $open_close_retval ) { croak( 'ERROR ERPNS00: Problem opening output file ' . q{'} . $perlapinames_filename . q{': } . $OS_ERROR, 'croaking' ); } print {$PERLAPINAMES_FILEHANDLE_OUT} $perlapinames_generated; $open_close_retval = close $PERLAPINAMES_FILEHANDLE_OUT; if ( not $open_close_retval ) { croak( 'ERROR ERPNS01: Problem closing output file ' . q{'} . $perlapinames_filename . q{': } . $OS_ERROR, 'croaking' ); } system 'perltidy', '-pbp', '--ignore-side-comment-lengths', '--converge', '-b', '-nst', q{-bext='/'}, '-q', $perlapinames_filename; print 'Regenerating Perl API Names... DONE!' . "\n";