Home | History | Annotate | Line # | Download | only in util 
      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 }
    142