Ticket #3: fixrefs.pl

File fixrefs.pl, 4.8 KB (added by debrouxl, 4 years ago)

Perl script that replaces incomplete paths with complete paths

Line 
1#!/usr/bin/perl -W
2use strict;
3use File::Find ();
4
5# For the convenience of &wanted calls, including -eval statements:
6use vars qw/*name /;
7*name = *File::Find::name;
8
9
10package main;
11    my %filesfullpath;
12
13sub buildfullpaths {
14    my @path;
15    my $shortname;
16   
17    if ($name =~ m@./(\C*?)\.(hsf|hsh)$@i) { # Select .hsf and .hsh files. FIXME: are HSH files really needed here (cause a false full path for printf).
18        $name = $1;
19        @path = split /\//, $name;
20        $shortname = $path[$#path];
21        $filesfullpath{$shortname} = $name;
22    }
23}
24
25sub putfullpaths {
26    my @path;
27    my $shortname;
28    my $filecontents;
29    my (@lines, @funcs);
30    my $line;
31   
32    if ($name =~ m@./(\C*?)\.(hsf|hsh)$@i) { # Select .hsf and .hsh files
33        @path = split /\//, $name;
34        $shortname = $path[$#path];
35       
36        open(INFILE, '+<', $name) or die "Can't open $name: $!";
37        read(INFILE, $filecontents, -s INFILE);
38        close INFILE;
39
40        # Split this line-based file into lines.
41        @lines = split /\n/, $filecontents;
42        for (my $i = 0; $i <= $#lines; $i++) {
43            $lines[$i] =~ s@\r@@g;
44            $lines[$i] =~ s@\n@@g;
45            $line = $lines[$i];
46
47            my $newline = '';
48           
49            # Handle interesting lines
50            if (   (index($line, 'See Also=') == 0)
51                || (index($line, 'In=') == 0)
52                || (index($line, 'Out=') == 0)
53               ) {
54                my $linetype = substr($line, 0, index($line, '=') + 1);
55                @funcs = split /, /, substr($line, index($line, '=') + 1);
56               
57                for my $func (@funcs) {
58                    if (index($func, '/') != -1) {
59                        # Skip complete paths
60                        $newline = $newline . $func . ', ';
61                    }
62                    else {
63                        if (defined($filesfullpath{$func})) {
64                            $newline = $newline . $filesfullpath{$func} . ', ';
65                        }
66                        else {
67                            if (index($func, ': ') != 0) {
68                                # Special case, found in e.g. 'ST_flags_var: ST_flags'.
69                                # It means that the link should point to 'ST_flags_var', but the text should read 'ST_flags'.
70                                my $file = substr($func, 0, index($func, ': '));
71                                my $linkname = substr($func, index($func,': ') + 2);
72                                if (defined($filesfullpath{$file})) {
73                                    $newline = $newline . $filesfullpath{$file} . ': ' . $linkname . ', ';
74                                    next;
75                                }
76                            }
77                            warn "$name: problem with string \"$func\"\n";
78                        }
79                    }
80                }
81               
82                # Strip excess ', '.
83                my $idx = rindex ($newline, ', ');
84                if ($idx != length($newline) - 2) {
85                    warn "Strange generated line \"$newline\"\n";
86                }
87                $newline = $linetype . substr($newline, 0, $idx);
88               
89                $lines[$i] = $newline;
90            }
91            elsif (index($line, '"$$LINK(') != -1) {
92                # <I>fsPtr</I> is a pointer to a <A HREF="$$LINK(FILES)">FILES</A> structure previously opened with <A HREF="$$LINK(TIOS_FOpen)">FOpen</A>."
93                @funcs = split /\"\$\$LINK\(/, $line;
94                for (my $j = 1; $j <= $#funcs; $j++) {
95                    my $idx = index($funcs[$j],')');
96                    my $func = substr($funcs[$j], 0, $idx);
97                    my $restofstring = substr($funcs[$j], $idx);
98                   
99                    if (index($func, '/') == -1) {
100                        if (defined($filesfullpath{$func})) {
101                            $funcs[$j] = $filesfullpath{$func} . $restofstring;
102                        }
103                        else {
104                            warn "Found a link to undef function \"" . $func . "\"\n";
105                        }
106                    }
107                    else {
108                        # Skip complete paths
109                    }
110                }
111                $lines[$i] = join '"$$LINK(', @funcs;
112            }
113        }
114        push @lines, ''; # Push additional EOL at EOF.
115        #~ print join ("\r\n", @lines);
116
117        open(OUTFILE, '+>', "$name") or die "Can't open $name: $!";
118        print OUTFILE join ("\r\n", @lines);
119        close OUTFILE;
120    }
121}
122
123
124    File::Find::find({wanted => \&buildfullpaths, no_chdir => 1}, '.');
125    $filesfullpath{'printf'} = 'stdio.h/printf'; # Override printf (found in printf.h/printf.hsh).
126    File::Find::find({wanted => \&putfullpaths, no_chdir => 1}, '.');