[gentoo-dev] Listing change for emerge rsync.

[gentoo-dev] Listing change for emerge rsync.

[Damien]

[-- Attachment #1: Type: text/plain, Size: 1079 bytes --]

Hi there,

I wrote this script that list the changes for your installed packages
when doing an 'emerge rsync'.

It has two problem, the first is that I don't know python so I wrote it
in perl (maybe someone could translate it), and the second is that it's
not very well written.

The second problem comes from the fact that a lot of ChangeLog are
broken and not clearly formatted, so I attempt to reformat the
changelog. It comes also from the fact that I'm not an expert in perl
coding ;).

It would be great if it could be translated to python and integrated
into emerge, but I'm sure there are better way to do what this script
does.

The script takes the output of emerge rsync as input, then look for
ChangeLog. If it found one line, it gets the name of the package and
check in /var/db/pkg/ to see if it is installed and then get the
installed version.
It then output the ChangeLog, formatting it nicely and stopping at the
currently installed version.

The script is attached to this mail.

To use it do a emerge rsync | emerge-listchanges


Bye bye.

Damien Merenne






[-- Attachment #2: emerge-listchanges --]
[-- Type: text/x-perl, Size: 5899 bytes --]

#!/usr/bin/perl -w
############################################################################
#
#      emerge-listchanges - Show changelog entries between 
#      the installed versions of ebuilds and new ebuild.
#      
#
#      Usage: emerge rsync | emerge-listchanges
#
#      Copyright (C) 2002  Damien Merenne <dam@capsule.org>
#
#      This program is free software; you can redistribute it and/or modify
#      it under the terms of the GNU General Public License as published by
#      the Free Software Foundation; either version 2 of the License, or
#      (at your option) any later version.
#
#      This program is distributed in the hope that it will be useful,
#      but WITHOUT ANY WARRANTY; without even the implied warranty of
#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#      GNU General Public License for more details.
#
#      You should have received a copy of the GNU General Public
#      License along with this program; if not, write to the Free
#      Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
#      MA 02111-1307 USA
#
#      
use strict;

my $db = "/var/db/pkg";
my $portage = "/usr/portage";
my @uninstalled;

# this if for less so that it prints the first line
print "\n";

while (<>)
{
    chop;

    # match updated ChangeLog
    if (/^(.*)\/(.*)\/ChangeLog/) {

	my $cat = $1;
	my $pkg = $2;
	my $version = "";

	# get the installed versuib
	opendir (DIR, "${db}/${cat}");
	while (my $pk = readdir(DIR)) {
	    next if ($pk =~ /^(\.|\.\.)$/);
	    next if ($pk !~ /$pkg/);

	    $pk =~ /-(\d+\..+)$/;
	    $version = $1;
	    last;
	}
	
	# if we don't find the package, it is not installed
	if ($version eq "") {
	    push @uninstalled, "${cat}/${pkg}";
	    next;
	}

	# print the ChangeLog entries
	print "Changelog for ${cat}/${pkg}\n\n";
	print_changelog("${portage}/${cat}/${pkg}/ChangeLog", $pkg, $version);

    }
}

# print uninstalled updated package
print "List of new package or not installed updated package:\n";
foreach (@uninstalled) {
    print "   ${_}\n";
}

# read a changelog file and format it nicely
sub print_changelog
{
    my $file = shift;
    my $pkg = shift;
    my $version = shift;

    my $fv = 0;
    my $cg = 0;

    my %info;
    my @changes = ();
    my %change;
    my $readchanges = 0;


    # open file
    open(CL, "< ${file}") || die ("Unable to open ${file}");
    while(<CL>) {

	chomp;

	# skip headers and empty line
	next if (/\#/);
	next if ($_ eq "");

	# match a new version
	if (/^\*${pkg}-(\d+.+),?\s+\((\d{1,2}) (\w+) (\d\d\d\d)\).*$/) {
	    # if we have a version waiting to be printed, do it
	    if ($fv) {
		my $pkgname=sprintf("%-25s" , "${pkg}-".$info{"version"});
		print "*${pkgname} (".$info{"out"}.")\n\n";

		# if there are changes push the last entry in the list of change entries
		# else it means this is a new upstream version
		if ($readchanges) {
		    push(@changes, \%change);
		    $readchanges = 0;
		} else {
		    print "   New upstream version.\n\n";
		    next;
		}

		# print each change
		foreach (@changes) {
		    print "   ".${$_}{"date"}."; ".${$_}{"author"}." ".${$_}{"mail"}." ";
 		    my $vir = 0;
 		    foreach (@{${$_}{"files"}}) {
 			print ", " if ($vir);
 			print "${_}";
 			$vir = 1;
 		    }
 		    print ":\n";
 		    print fold(${$_}{"change"}, 65, "          ")."\n\n";
		}
		print "\n";

		%info = ();
		%change = ();
		@changes = ();
		$cg = 0;
		
	    }

	    # stop if this version is the installed version
	    last if (/^\*${pkg}-${version}/);

	    # store the version information
	    $info{"version"} = $1;
	    $info{"out"} = sprintf("%02i %s %s", $2, $3, $4);
	    $fv = 1;
	}

	if ($fv) {
	    # if we are in a version, try to match a new entry 
	    # (these are often broken so the regexp try to match strange format)
	    if (/^\s+(\d{1,2})\s+(\w+)\s+(\d\d\d\d)\s*;?\s+(\w+.*\w+)\s+(<.+@.+\..+>)\s*([^ :][^:]*[^ :])*\s*(:?)\s*(.*)$/) {
		$readchanges = 1;
		# if we have already read a change, then put that entry in the list of change
		if ($cg) {
		    my %copy = %change;
		    push(@changes, \%copy);
		    %change = ();
		}
		$cg = 1;

		# get all the data
		$change{"date"} = sprintf("%2i %s %s", $1, $2, $3);
		$change{"author"} = $4;
		$change{"mail"} = $5;

		my @files;

		# here we have a big problem, they are different kind of bad formatted entries:
		# 20 Feb 2002; nom <mail> files, files :   which is correct
		# 20 Feb 2002; nom <mail> : changes   which is wrong 
		# 20 Feb 2002; nom <mail> files, files : changes    which is wrong
		# we try to correct wrong entries
		if ($7 eq ":") {
		    if ($6) {
			@files = split (/\s*(,)\s*/, $6);
		    } else {
			@files = ();
		    }
		} else {
		    $change{"change"} = "${6}" if ($6);
		}

		if (exists $change{"change"}) {
		    $change{"change"} .= " ${8}";
		} else {
		    $change{"change"} = "${8}";
		}
		
		$change{"files"} = \@files;
		next;
	    }
	    
	    # if we are here, it means that the text is a description of a change
	    # so store it in the current change
	    if (/^\s+[^ ](.*)$/) {
		if (exists $change{"change"}) {
		    $change{"change"} .= " ${_}";
		} else {
		    $change{"change"} = "${_}";
		}
		next;
	    }
	}
    }
}

# wrap lines
sub fold
{
    my $str = shift;
    my $mxl = shift;
    my $ident = shift;

    my $ret = "";
    my $line = "";
    my @words = split (/\s+/, $str);
    foreach (@words) {
	if ((length($line) + length($_)) > $mxl) {
	    $ret .= $ident . $line . "\n";
	    $line = $_;
	    next;
	} else {
	    if ($line eq "") {
		$line .= $_;
	    } else {
		$line .= " ".$_;
	    }
	}
    }
    $ret .= $ident . $line;
    
    return $ret;
}