#!/usr/bin/perl

# $Id: urpmdiff,v 1.25 2006/04/24 08:33:24 rgarciasuarez Exp $

our $VERSION = '1.9';

=head1 NAME

urpmdiff - shows diff between rpms

=head1 SYNOPSIS

    urpmdiff [-f] [-5] [-d] [-m] [-c] [-v] old.rpm new.rpm
    urpmdiff [-lt|--le|--eq|--ne|--ge|--gt] [-v] old.rpm new.rpm

=head1 DESCRIPTION

urpmdiff shows the differences between two rpms. It's intended to help
packagers to know what has changed between an old and a new version of an rpm.
Its output is reminiscent of the unified diff format.

=head1 OPTIONS

=over 4

=item -f

Lists added and removed files

=item -5

Lists modified files (according to their MD5SUM)

=item -m

Lists file mode and ownership changes

=item -d

Lists dependency differences (Requires, Provides, Obsoletes, Conflicts)

=item -c

Lists changelog differences

=item -lt --le --eq --ne --ge --gt

Those options turn off output and perform version comparison (respectively less
than, less than or equal, equal, and so on.) In this case you can pass either
rpm file names or version numbers.

=item -v

Be verbose. Useful for version comparisons. For listing diffs, lists unchanged
lines too.

=back

Without any option, C<-fmd> is assumed.

=head1 EXIT STATUS

0 on success, 2 on failure.

If one of the version comparison switches was specified, returns 0 if the
specified condition is satisfied, 1 otherwise, and 2 on failure.

=head1 AUTHOR

Copyright (C) 2005 Mandrakesoft, (C) 2005, 2006 Mandriva,
Rafael Garcia-Suarez E<lt>rgarciasuarez@mandriva.comE<gt>

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, or (at your option)
any later version.

=cut

use strict;
use Getopt::Long;
use Algorithm::Diff 'sdiff';
use URPM;
use Pod::Usage;

sub usage () {
    pod2usage({ -verbose => 1 });
    exit 2;
}

my %methods;
@methods{qw(files files_md5sum files_group files_mode files_owner provides requires obsoletes conflicts changelog)} = ();
my $comparison = '';
Getopt::Long::Configure(qw(bundling gnu_compat permute));
my %optionsspec = (
    'h|help' => \&usage,
    'c' => sub { $methods{changelog} = 1 },
    'f' => sub { $methods{files} = 1 },
    '5' => sub { $methods{$_} = 1 for qw(files files_md5sum) },
    'm' => sub { $methods{$_} = 1 for qw(files files_group files_mode files_owner) },
    'd' => sub { $methods{$_} = 1 for qw(provides requires obsoletes conflicts) },
    'v' => \our $verbose,
    version => sub { print <<VERSION; exit 2 }
$0 version $VERSION
VERSION
);
for my $op (qw(lt le eq ne ge gt)) {
    $optionsspec{$op} = sub { $comparison = $op };
}
GetOptions( %optionsspec );
my @methods = grep $methods{$_}, keys %methods;
#- default methods
$comparison || @methods or @methods = grep !/files_md5sum|changelog/, keys %methods;
@methods{@methods} = ( 1 ) x @methods;

if (@ARGV != 2) { warn qq(Not enough arguments\n\n); usage }
my $urpm = new URPM;
my @versions;
for (@ARGV) {
    unless (-f && -r _) {
	if (@methods) {
	    warn qq(Can't read "$_"\n\n);
	    usage;
	} else {
	    push @versions, $_;
	    next;
	}
    }
    @methods and $urpm->parse_rpm($_, keep_all_tags => 1);
    if ($comparison) {
	push @versions, qx(/bin/rpm -qp --qf '%{epoch}:%{version}-%{release}' '$_');
    }
}

if ($comparison) {
    s/^(?:\(none\))?:// for @versions;
    # remove epoch if not defined in both versions
    if ("@versions" =~ y/:/:/ != 2) {
	s/^\d*:// for @versions;
    }
}

my @rpm;
my $i = 0;
my @filemethods = grep /^files/, @methods;
@methods and $urpm->traverse(sub {
    my ($pkg) = @_;
    for (@methods) {
	if (/^files/) {
	    $rpm[$i]{$_} = [ $pkg->$_ ];
	} elsif ($_ eq 'changelog') {
	    my @t = $pkg->changelog_time;
	    my @n = $pkg->changelog_name;
	    my @x = map { s/^/  /gm; $_ } $pkg->changelog_text;
	    my @e;
	    for my $i (0 .. $#t) {
		my $time = localtime($t[$i]);
		$time =~ s/ \d\d:.*//;
		push @e, $time . " $n[$i]\n$x[$i]";
	    }
	    $rpm[$i]{$_} = \@e;
	} else {
	    $rpm[$i]{$_} = [ sort $pkg->$_ ];
	}
    }
    if (@filemethods) {
	# create a hash of file informations to find which ones have changed
	for my $f (0 .. $#{$rpm[$i]{files}}) {
	    $rpm[$i]{filehash}[$f] = join "\0", map $rpm[$i]{$_}[$f], @filemethods;
	}
    }
    print $i ? '+++' : '---', ' ', scalar $pkg->fullname, "\n";
    ++$i;
});

if (@filemethods) {
    my $format_file;
    if (grep /mode/, @filemethods) {
	$format_file = sub {
	    my (@i) = split /\0/, $_[0];
	    my %i = map { $filemethods[$_] => $i[$_] } 0 .. $#filemethods;
	    sprintf("%s:%s %04o %s", $i{files_owner}, $i{files_group}, $i{files_mode} & 07777, $i{files});
	};
    } else {
	$format_file = sub { (split /\0/, $_[0])[0] };
    }
    my @sd = sdiff($rpm[0]{filehash}, $rpm[1]{filehash});
    grep $_->[0] ne 'u', @sd and print "@@ files @@\n";
    for my $diff (@sd) {
	$diff->[0] =~ /[-c]/ and print "- ", $format_file->($diff->[1]), "\n";
	$diff->[0] =~ /[+c]/ and print "+ ", $format_file->($diff->[2]), "\n";
	$verbose && $diff->[0] eq 'u' and print "  ", $format_file->($diff->[1]), "\n";
    }
}

for my $m (grep $methods{$_}, qw(provides requires obsoletes conflicts changelog)) {
    my @sd = sdiff($rpm[0]{$m}, $rpm[1]{$m});
    grep $_->[0] ne 'u', @sd and print "@@ $m @@\n";
    for my $diff (@sd) {
	$diff->[0] =~ /[-c]/ and print "- ", $diff->[1], "\n";
	$diff->[0] =~ /[+c]/ and print "+ ", $diff->[2], "\n";
	$verbose && $diff->[0] eq 'u' and print "  ", $diff->[1], "\n";
    }
}

# version comparison

sub verbose_exit {
    $verbose and print $_[0] ? "yes\n" : "no\n";
    exit($_[0] ? 0 : 1);
}

if ($comparison) {
    my $c = URPM::rpmvercmp(@versions);
    if    ($comparison eq 'lt') { verbose_exit($c == -1) }
    elsif ($comparison eq 'le') { verbose_exit($c != 1) }
    elsif ($comparison eq 'eq') { verbose_exit($c == 0) }
    elsif ($comparison eq 'ne') { verbose_exit($c != 0) }
    elsif ($comparison eq 'ge') { verbose_exit($c != -1) }
    elsif ($comparison eq 'gt') { verbose_exit($c == 1) }
}

exit 0;
