mk/su-doc-strip.pl

   1 #!/usr/bin/env perl
   2 require 5.008_001;
   3 #@ Strip *! style documents from C/C++ code.
   4 #@ Assumes that such lines are exclusive, and that /*!< */ lines
   5 #@ are followed by no other such comment.
   6 #@ Synopsis: su-doc-strip.pl :FILE:
   7 # Public Domain
   8
   9 ##  --  >8  --  8<  --  ##
  10
  11 use diagnostics -verbose;
  12 use strict;
  13 use warnings;
  14
  15 sub main_fun{
  16    die 'False usage' if @ARGV == 0;
  17
  18    while(@ARGV > 0){
  19       my ($f, $i, $fd, @lines) = (shift @ARGV, 0);
  20
  21       # Read it, stripping the comments
  22       die "Cannot open $f for reading: $^E"
  23          unless open $fd, '<:raw', $f;
  24       while(<$fd>){
  25          chomp;
  26          if($i){
  27             if($_ =~ /^(.*?)\*\/[[:space:]]*(.*)$/){
  28                $i = 0;
  29                push @lines, $2 if length $2
  30             }
  31          }elsif($_ =~ /^(.*?)[[:space:]]*\/\*!(.*)$/){
  32             my ($m1, $m2) = ($1, $2);
  33             if($m2 =~ /^(.*?)\*\/[[:space:]]*(.*)$/){
  34                my $l = $m1 . $2;
  35                push @lines, $l if length($l)
  36             }else{
  37                $i = 1;
  38                push @lines, $m1 if length $m1
  39             }
  40          }else{
  41             push @lines, $_ if length $_
  42          }
  43       }
  44       die "Cannot close $f after reading: $^E"
  45          unless close $fd;
  46
  47       die "Cannot open $f for writing: $^E"
  48          unless open $fd, '>:raw', $f;
  49       while(@lines){
  50          $i = shift @lines;
  51          die "Cannot write to $f: $^E"
  52             unless print $fd $i, "\n"
  53       }
  54       die "Cannot close $f after writing: $^E"
  55          unless close $fd
  56    }
  57    exit 0
  58 }
  59
  60 {package main; main_fun()}
  61
  62 # s-it-mode