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' <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         else {
  13                 push(@files, $a);
  14                 }
  15         }
  16
  17 $tempdir = "/tmp/pod";
  18 mkdir($tempdir, 0755);
  19
  20 foreach $f (@files) {
  21         # Read in the file
  22         if (!open(SRC, $f)) {
  23                 print STDERR "Failed to open $f : $!";
  24                 next;
  25                 }
  26         chomp(@lines = <SRC>);
  27         close(SRC);
  28
  29         # Scan line by line, looking for top-level subs with comments before
  30         # them.
  31         print "Processing $f :\n";
  32         $i = 0;
  33         @out = ( );
  34         @cmts = ( );
  35         $count = 0;
  36         while($i<@lines) {
  37                 if ($lines[$i] =~ /^sub\s+(\S+)\s*$/) {
  38                         # Start of a function .. backtrack to get comments
  39                         $name = $1;
  40                         $args = undef;
  41                         if ($cmts[0] =~ /^\#+\s*(\Q$name\E)\s*(\((.*))/) {
  42                                 # Found args in comments .. maybe multi-line
  43                                 $args = $2;
  44                                 shift(@cmts);
  45                                 while($args !~ /\)\s*$/ && @cmts) {
  46                                         $cont = $cmts[0];
  47                                         shift(@cmts);
  48                                         $cont =~ s/^\s*#+\s*//;
  49                                         $args .= " ".$cont;
  50                                         }
  51                                 $args = undef if ($args =~ /^\(\s*\)$/);
  52                                 }
  53                         if (@cmts || $args) {
  54                                 push(@out, "=head2 $name$args");
  55                                 push(@out, "");
  56                                 if (!@cmts) {
  57                                         @cmts = ( "MISSING DOCUMENTATION" );
  58                                         }
  59                                 foreach $c (@cmts) {
  60                                         $c =~ s/^\s*#+\s*//;
  61                                         push(@out, $c);
  62                                         }
  63                                 push(@out, "");
  64                                 push(@out, "=cut");
  65                                 }
  66                         push(@out, $lines[$i]);
  67                         @cmts = ( );
  68                         $count++;
  69                         }
  70                 elsif ($lines[$i] =~ /^\#/) {
  71                         # Comments - add to temporary list
  72                         push(@cmts, $lines[$i]);
  73                         }
  74                 else {
  75                         # Some other line - write out, and flush comments
  76                         push(@out, @cmts, $lines[$i]);
  77                         @cmts = ( );
  78                         }
  79                 $i++;
  80                 }
  81         print "  Fixed $count functions\n";
  82
  83         # Write out the file to a temp location
  84         $basef = $f;
  85         $basef =~ s/^.*\///;
  86         $temp = "$tempdir/$basef";
  87         print "  Writing to $temp\n";
  88         open(TEMP, ">$temp");
  89         foreach $o (@out) {
  90                 print TEMP $o,"\n";
  91                 }
  92         close(TEMP);
  93
  94         # Use perl -c to verify syntax
  95         $err = `perl -c $temp 2>&1`;
  96         if ($?) {
  97                 print "  Perl verification FAILED\n";
  98                 next;
  99                 }
 100         print "  Perl verification OK\n";
 101
 102         # Show diff if asked
 103         # XXX
 104
 105         # Copy over original file (with cat)
 106         # XXX
 107         }
 108