[inetdoc.LINUX]

Ce script Perl modifie les balises XML du journal produit par la commande svn log --xml en y ajoutant le résultat de la commande diffstat. Le nouveau jeu de balises est donné dans la Section 7.2, « Génération de la page ChangeLog avec SVN ».

#!/usr/bin/perl -w
#  $Id: extract_changelog_diffstat.pl 1174 2007-10-09 14:33:58Z latu $
#  SVN XML log is edited to insert 'diffstat' result for every
#  'M'odified source file
#
#  SVN XML log tag structure:
#  <paths>
#   <path action="(A|D|M"> source file path </path>
#   <path action="A"> source file path </path>
#   ...
#  </paths>
#  
#  New tag structure:
#  <objects>
#   <object>
#    <path action="M"> source file path </path>
#    <stats> diffstat information </stats
#   </object>
#   <object>
#    <path action="D"> source file path </path>
#   </object>
#   ... 
#  </objects>
#
#  Important !
#  . This is definitely not the best Perl script you've ever read.
#  . Calling svn diff for every single file is inefficient but
#    sorting of file entries is needed to call svn diff for multiple
#    files. Maybe for the next release.
#    
#  Copyright (c) 2007 Philippe Latu.
#
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in
#     the documentation and/or other materials provided with the
#     distribution.
#  3. The name of the author may not be used to endorse or promote
#     products derived from this software without specific prior
#     written permission.
#
#  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
#  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
#  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
#  DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
#  GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
#  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
#  IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
#  OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
#  IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

use strict;
use Symbol;
use POSIX;

my $infile=shift;

if (!defined $infile) {
  open(IN,"<&STDIN") or die "Could not open an input stream";
  }
else {
  open(IN,"<$infile") or die "Could not open an input stream";
  }

my $filename = "";
my $s = "";
my $revision_delta = "";
my @pipe_text = ();

while (<IN>) {

  chomp;

  # Différence entre la version courante et la précédente
  if ( /revision=/ ) {
    $s = $_;
    $s =~ s/[^0-9]//g; 
    $revision_delta = $s . ":" . --($s);
    }

  # Substitution balise paths -> objects
  if ( /paths/ ) {
    $_ =~ s/paths/objects/;
    }

  # Ajout balise object
  if ( /<path/ ) {
    $_ = "<object>\n" . $_;
    }

  # Traitement sur les fichiers modifiés uniquement
  if ( /action=\"M\"/ ) {
    # extraction nom de fichier
    $filename = $_;
    $filename =~ s/action=\"M">\/trunk\///;
    $filename =~ s/<\/path>//;
    $filename =~ s/^ *//;
    # diff si le fichier existe et si ce n'est pas une image
    if ( -f $filename && $filename !~/(gif|png|jpg)/) {
      # fork appels commandes
      my $pid = open CMD, "svn diff -r $revision_delta $filename | diffstat -p0 -w60 2>/dev/null |";
      if (!defined $pid) {
        die "$0: can't fork svn: $!\n";
      }
      while ($s = <CMD>) {
        if ( $s !~ /(file|files) changed/ ) {
          push(@pipe_text, $s);
        }
      }
      close CMD;
      # modification sur les propriétés de l'objet uniquement
      if ( (@pipe_text) == 0 ) {
        $_ .= "<stats>propriétés subversion</stats>";
      }
      else {
        # nouvelles balises pour les fichiers modifiés
        foreach $s ( @pipe_text ) {
          chomp ($s);
          my @parts = split /\|/, $s;
          $parts[0] =~ s/ //g;
          $_ = "  action=\"M\">\/trunk\/" . $parts[0] . "</path>\n";
          $parts[1] =~ s/^ *//;
          $_ .=  "<stats>" . $parts[1] . "</stats>";
        }
        @pipe_text = ();
      }
    $_ .= "\n</object>";
    }
    else {
      $_ .= "\n</object>";
    }
  }
  elsif ( /action=\"(A|D)\"/ ) {
    $_ .= "\n</object>";
  }
  # recopie de l'entrée
  print $_ . "\n";
}

close(IN);