From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

WBRASWELL / RPerl-7.000000 / script / development / perlapinames_regenerate.pl 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141

              
#!/usr/bin/env 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";