]>
Commit | Line | Data |
---|---|---|
aedac96c MC |
1 | #! /usr/bin/env perl |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | use File::Temp qw/tempfile/; | |
6 | ||
7 | my $topdir = shift; | |
8 | ||
9 | processallfiles($topdir); | |
10 | print "Success\n"; | |
11 | ||
12 | sub processallfiles { | |
13 | my $dir = shift; | |
14 | my @files = glob "$dir/*.c $dir/*.h $dir/*.h.in $dir/*.pod *dir/*.pod.in"; | |
15 | ||
16 | open (my $STDOUT_ORIG, '>&', STDOUT); | |
17 | ||
18 | foreach my $file (@files) { | |
19 | my ($tmpfh, $tmpfile) = tempfile(); | |
20 | ||
21 | print "Processing $file\n"; | |
22 | open(STDOUT, '>>', $tmpfile); | |
23 | open(INFILE, $file); | |
24 | processfile(\*INFILE); | |
25 | close(STDOUT); | |
26 | rename($tmpfile, $file); | |
27 | unlink($tmpfile); | |
28 | # restore STDOUT | |
29 | open (STDOUT, '>&', $STDOUT_ORIG); | |
30 | } | |
31 | ||
32 | #Recurse through subdirs | |
33 | opendir my $dh, $dir or die "Cannot open directory"; | |
34 | ||
35 | while (defined(my $subdir = readdir $dh)) { | |
36 | next unless -d "$dir/$subdir"; | |
37 | next if (rindex $subdir, ".", 0) == 0; | |
38 | processallfiles("$dir/$subdir"); | |
39 | } | |
40 | closedir $dh; | |
41 | } | |
42 | ||
43 | sub processfile { | |
44 | my $fh = shift; | |
45 | my $multiline = 0; | |
46 | my @params; | |
47 | my $indent; | |
48 | my $paramstr = ""; | |
49 | ||
50 | foreach my $line (<$fh>) { | |
51 | chomp($line); | |
52 | if (!$multiline) { | |
53 | if ($line =~ /^(.+)_with_libctx\((.*[^\\])$/) { | |
54 | my $preline = $1; | |
55 | my $postline = $2; | |
56 | #Strip trailing whitespace | |
57 | $postline =~ s/\s+$//; | |
58 | print $preline.'_ex('; | |
59 | my @rets = extracttoclose($postline); | |
60 | if (@rets) { | |
61 | print "$postline\n"; | |
62 | $multiline = 0; | |
63 | } else { | |
64 | $multiline = 1; | |
65 | $paramstr = $postline; | |
66 | $indent = (length $preline) + (length '_ex('); | |
67 | } | |
68 | } else { | |
69 | #Any other reference to _with_libctx we just replace | |
70 | $line =~ s/_with_libctx/_ex/g; | |
71 | print $line."\n"; | |
72 | } | |
73 | } else { | |
74 | #Strip leading whitespace | |
75 | $line =~ s/^\s+//; | |
76 | #Strip trailing whitespace | |
77 | $line =~ s/\s+$//; | |
78 | my @rets = extracttoclose($paramstr.$line); | |
79 | if (@rets) { | |
80 | my $pre = shift @rets; | |
81 | my $post = shift @rets; | |
82 | @params = split(",", $pre); | |
83 | my @params = grep(s/^\s*|\s*$//g, @params); | |
84 | formatparams($indent, @params); | |
85 | print ')'.$post."\n"; | |
86 | $multiline = 0; | |
87 | } else { | |
88 | $paramstr .= $line; | |
89 | } | |
90 | } | |
91 | } | |
92 | ||
93 | die "End of multiline not found" if $multiline; | |
94 | } | |
95 | ||
96 | sub formatparams { | |
97 | my $indent = shift; | |
98 | my @params = @_; | |
99 | ||
100 | if (@params) { | |
101 | my $param = shift @params; | |
102 | my $lensofar += $indent + (length $param) + 1; | |
103 | ||
104 | print "$param"; | |
105 | print "," if @params; | |
106 | ||
107 | while (@params) { | |
108 | my $param = shift @params; | |
109 | ||
110 | if (($lensofar + (length $param) + 2) > 80) { | |
111 | print "\n".(" " x $indent); | |
112 | print $param; | |
113 | $lensofar = $indent + (length $param) + 1; | |
114 | } else { | |
115 | print ' '.$param; | |
116 | $lensofar += (length $param) + 2; | |
117 | } | |
118 | print "," if @params; | |
119 | } | |
120 | } | |
121 | } | |
122 | ||
123 | sub extracttoclose { | |
124 | my $inline = shift; | |
125 | my $outline = ""; | |
126 | ||
127 | while ($inline =~ /^([^\)]*?)\((.*)$/) { | |
128 | my @rets = extracttoclose($2); | |
129 | if (!@rets) { | |
130 | return (); | |
131 | } | |
132 | my $inside = shift @rets; | |
133 | my $post = shift @rets; | |
134 | $outline .= $1.'('.$inside.')'; | |
135 | $inline = $post; | |
136 | } | |
137 | if ($inline =~ /^(.*?)\)(.*)$/) { | |
138 | return ($outline.$1, $2); | |
139 | } | |
140 | return (); | |
141 | } |