comments-to-pod.pl

   1 #!/usr/local/bin/perl
   2 # Convert Webmin function comments to POD format
   3
   4 # Parse command line
   5 @ARGV || die "usage: webmin-to-pod.pl [--svn 'comment'] [--overwrite] <file> ...";
   6 while(@ARGV) {
   7         $a = shift(@ARGV);
   8         if ($a eq "--svn") {
   9                 $svn = shift(@ARGV);
  10                 $svn || die "--svn must be followed by a commit comment";
  11                 }
  12         elsif ($a eq "--overwrite") {
  13                 $overwrite = 1;
  14                 }
  15         else {
  16                 push(@files, $a);
  17                 }
  18         }
  19
  20 $tempdir = "/tmp/pod";
  21 mkdir($tempdir, 0755);
  22
  23 foreach $f (@files) {
  24         # Read in the file
  25         if (!open(SRC, $f)) {
  26                 print STDERR "Failed to open $f : $!";
  27                 next;
  28                 }
  29         chomp(@lines = <SRC>);
  30         close(SRC);
  31
  32         $basef = $f;
  33         $basef =~ s/^.*\///;
  34
  35         # Scan line by line, looking for top-level subs with comments before
  36         # them.
  37         print "Processing $f :\n";
  38         $i = 0;
  39         @out = ( );
  40         @cmts = ( );
  41         $count = 0;
  42         while($i<@lines) {
  43                 if ($lines[$i] =~ /^sub\s+(\S+)\s*$/) {
  44                         # Start of a function .. backtrack to get comments
  45                         $name = $1;
  46                         $args = undef;
  47                         if ($cmts[0] =~ /^\#+\s*(\Q$name\E)\s*(\((.*))/) {
  48                                 # Found args in comments .. maybe multi-line
  49                                 $args = $2;
  50                                 shift(@cmts);
  51                                 while($args !~ /\)\s*$/ && @cmts) {
  52                                         $cont = $cmts[0];
  53                                         shift(@cmts);
  54                                         $cont =~ s/^\s*#+\s*//;
  55                                         $args .= " ".$cont;
  56                                         }
  57                                 $args = undef if ($args =~ /^\(\s*\)$/);
  58                                 }
  59                         if (@cmts || $args) {
  60                                 push(@out, "=head2 $name$args");
  61                                 push(@out, "");
  62                                 if (!@cmts) {
  63                                         @cmts = ( "MISSING DOCUMENTATION" );
  64                                         }
  65                                 foreach $c (@cmts) {
  66                                         $c =~ s/^\s*#+\s*//;
  67                                         push(@out, $c);
  68                                         }
  69                                 push(@out, "");
  70                                 push(@out, "=cut");
  71                                 }
  72                         push(@out, $lines[$i]);
  73                         @cmts = ( );
  74                         $count++;
  75                         }
  76                 elsif ($lines[$i] =~ /^\#/) {
  77                         # Comments - add to temporary list
  78                         push(@cmts, $lines[$i]);
  79                         }
  80                 elsif (scalar(@cmts) == $i && @cmts) {
  81                         # End of first comments block - convert to head1
  82                         push(@out, "=head1 $basef");
  83                         push(@out, "");
  84                         if ($cmts[0] =~ /\Q$basef\E/) {
  85                                 shift(@cmts);
  86                                 }
  87                         foreach my $c (@cmts) {
  88                                 $c =~ s/^\s*#\s*//;
  89                                 push(@out, $c);
  90                                 }
  91                         push(@out, "");
  92                         push(@out, "=cut");
  93                         push(@out, "");
  94                         @cmts = ( );
  95                         }
  96                 else {
  97                         # Some other line - write out, and flush comments
  98                         push(@out, @cmts, $lines[$i]);
  99                         @cmts = ( );
 100                         }
 101                 $i++;
 102                 }
 103         print "  Fixed $count functions\n";
 104
 105         # Write out the file to a temp location
 106         $temp = "$tempdir/$basef";
 107         print "  Writing to $temp\n";
 108         open(TEMP, ">$temp");
 109         foreach $o (@out) {
 110                 print TEMP $o,"\n";
 111                 }
 112         close(TEMP);
 113
 114         # Use perl -c to verify syntax
 115         $err = `perl -c $temp 2>&1`;
 116         if ($?) {
 117                 print "  Perl verification FAILED\n";
 118                 next;
 119                 }
 120         print "  Perl verification OK\n";
 121
 122         # Show diff if asked
 123         # XXX
 124
 125         # Copy over original file (with cat)
 126         if ($overwrite) {
 127                 $out = `cat $temp 2>&1 >$f`;
 128                 if ($?) {
 129                         print "  Save FAILED : $out\n";
 130                         }
 131                 else {
 132                         print "  Save OK\n";
 133                         }
 134                 }
 135         if ($overwrite && $svn) {
 136                 ($dirf = $f) =~ s/\/[^\/]+$//;
 137                 $out = `cd $dirf && svn commit -m "$svn" $basef 2>&1`;
 138                 if ($?) {
 139                         print "  SVN FAILED : $out\n";
 140                         }
 141                 else {
 142                         print "  SVN OK\n";
 143                         }
 144                 }
 145         }
 146