scripts/readme.pl

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