scripts/readme.pl

   1 # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   2 # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   3 # This file is part of Coccinelle.
   4 #
   5 # Coccinelle is free software: you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation, according to version 2 of the License.
   8 #
   9 # Coccinelle is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  16 #
  17 # The authors reserve the right to distribute this or future versions of
  18 # Coccinelle under other licenses.
  19
  20
  21 #!/usr/bin/perl
  22 #
  23 # ARGV: 0 = replacement text, 1 = file w. list of files
  24 #
  25
  26 $debug = 0;
  27 $retain = 1;                    # 1 = retain old status
  28
  29 #----------------------------------------------------------------------
  30 $header = 0;  # 0 = not seen header yet; 1 = seen beginning; 2 = seen end
  31
  32 $currentfile = "";
  33 $currentstatus = "";
  34 $oldstatus = "";
  35 @files = ();
  36
  37 # Get replacement text
  38 $replace = shift;
  39
  40 # Get files of interest
  41 open(FILES,shift);
  42 @files = <FILES>;
  43 close(FILES);
  44
  45 # Remove file name suffixes
  46 foreach $_ (@files) {
  47     s/^([^.]+)\..+$/\1/;
  48     chop;
  49     print "--> added [$_]\n" if $debug;
  50 }
  51
  52 # Process std. input
  53 while(<>) {
  54
  55     # Find an ignore header
  56     if(/^-+$/) {
  57         $header = $header + 1;
  58     }
  59
  60     #
  61     if($header > 1) {
  62
  63         # Filename
  64         if(/^([0-9a-zA-Z_-]+)\.c\s*$/) {
  65             $currentfile = $1;
  66             $currentstatus = "";
  67             print "--> currentfile: [$currentfile]\n" if $debug;
  68         }
  69
  70         # Status code
  71         if(/^(\s+\*\s+)\[status\]([ \t\f]*)(\S*)$/) {
  72             $currentstatus = $3;
  73
  74             print "--> $currentfile [$currentstatus]\n" if $debug;
  75
  76             if(grep {/^$currentfile$/} @files) {
  77                 s/^(\s+\*\s+\[status\])[ \t\f]*(.*)$/\1 $replace/;
  78                 print "==>" if $debug;
  79
  80                 if($retain && ($currentstatus ne "")) {
  81                     $oldstatus = "  * [old-status] $currentstatus\n";
  82                 }
  83             }
  84
  85             $currentfile ="";
  86
  87         }
  88
  89     }
  90
  91     #
  92     print "$_";
  93
  94     if($oldstatus ne "") {
  95         print $oldstatus;
  96         $oldstatus = "";
  97     }
  98
  99 }