#!/usr/bin/perl
# Created on: 2008-01-16 08:05:58
# Create by: ivanw
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$
use strict;
use warnings;
use version;
use Scalar::Util;
use List::Util qw/max min/;
use Getopt::Long;
use Pod::Usage;
use Data::Dumper qw/Dumper/;
use English qw/ -no_match_vars /;
use FindBin qw/$Bin/;
use VCS::Which;
use IO::Prompt qw/prompt/;
use Path::Class;
our $VERSION = version->new('0.4.0');
my ($name) = $PROGRAM_NAME =~ m{^.*/(.*?)$}mxs;
my %option = (
revision => '',
diff => 'vimdiff',
verbose => 0,
man => 0,
help => 0,
VERSION => 0,
);
if ( !@ARGV ) {
pod2usage( -verbose => 1 );
}
main();
exit 0;
sub main {
Getopt::Long::Configure('bundling');
GetOptions(
\%option,
'file|f=s',
'revision|r=s',
'change|c=i',
'replay|R',
'max|m=i',
'prev|previous|p',
'three|3',
'diff|d=s',
'test|t!',
'verbose|v+',
'man',
'help',
'VERSION!',
) or pod2usage(2);
$option{'file'} ||= shift @ARGV;
if ( $option{'VERSION'} ) {
print "$name Version = $VERSION\n";
exit 1;
}
elsif ( $option{'man'} ) {
pod2usage( -verbose => 2 );
}
elsif ( $option{'help'} || !-e $option{'file'} ) {
pod2usage( -verbose => 1 );
}
# sort out the revision names
my ( $rev_old, $rev_new ) = ('', '');
if ( $option{'revision'} ) {
( $rev_old, $rev_new )
= $option{'revision'} =~ /:/xms ? ( split /:/xms, $option{'revision'} )
: ( $option{'revision'} );
}
if ( $option{'change'} ) {
( $rev_old, $rev_new ) =
$option{'change'} > 0 ? ( $option{'change'} - 1, $option{'change'} )
: ( $option{'change'}, $option{'change'} - 1 );
$option{'revision'} = "$rev_old\:$rev_new";
}
# create the temporary file object name
my $tmp = "/tmp/$$.$name." . file($option{'file'})->basename;
# create a new VCS::Which object for the file of interest
my $vcs = VCS::Which->new(dir => $option{file});
if ($option{replay}) {
my $first = 1;
my $warned = 0;
my $versions = $vcs->log( $option{file} );
if ( $option{verbose} > 2 ) {
my $i = 0;
my $j = -2;
print map {$i++ . "\t" . $j-- . "\t$versions->{$_}{rev}\n"} sort keys %$versions;
}
my $last;
die "Could not find any versions for $option{file}!\n" if !%$versions;
while ( %$versions ) {
if ( ( $option{prev} || $option{three} ) && $rev_old ) {
unlink $last if $last && -e $last;
$last = "$tmp.$rev_old";
}
else {
unlink "$tmp.$rev_old" if -e "$tmp.$rev_old";
}
my $rev_no = max keys %$versions;
my $rev = delete $versions->{$rev_no};
$rev_old = $rev->{rev};
my @files
= $option{three} && $last ? ( $option{'file'}, $last, "$tmp.$rev_old" )
: $option{prev} && $last ? ( $last, "$tmp.$rev_old" )
: ( $option{'file'}, "$tmp.$rev_old" );
my $diff = "$option{diff} " . join ' ', @files;
# write the revisioned file to disk
write_file( "$tmp.$rev_old", scalar $vcs->cat($option{file}, $rev_old) );
if ($option{test} || $option{verbose}) {
print "$diff\n" if $option{verbose} > 1;
my $other = { %$rev };
if ( @files == 2 ) {
my $diff = "diff -wuN " . join ' ', @files;
my @diff = `$diff`;
$other->{'Lines added'} = grep {/^([+] [^+] )/gxms} @diff;
$other->{'Lines removed'} = grep {/^([-] [^-] )/gxms} @diff;
}
local $Data::Dumper::Indent = 1;
local $Data::Dumper::Sortkeys = 1;
print Data::Dumper->Dump([$other], ["*$rev_no"]);
}
if ( !$first || $option{verbose} ) {
print "y = yes continue (Default), n = not stop processing, s = skip this revision\n" if !$warned++;
my $ans = prompt(
"Next revision $rev_old: Continue? [yns] ",
'-tty',
'-1',
-d => 'y',
);
print "\n\n";
$ans = lc $ans;
last if $ans eq 'n' || $ans eq 'q';
next if $ans eq 's';
}
# run the diff if not testing
system $diff if !$option{test};
$first = 0;
}
unlink "$tmp.$rev_old" if -e "$tmp.$rev_old";
unlink $last if $last && -e $last;
}
elsif ($rev_new) {
write_file( "$tmp.$rev_new", scalar $vcs->cat($option{file}, $rev_new) );
write_file( "$tmp.$rev_old", scalar $vcs->cat($option{file}, $rev_old) );
if ($option{test} || $option{verbose}) {
print "$option{diff} $tmp.$rev_new $tmp.$rev_old\n";
}
if (!$option{test}) {
exec "$option{diff} $tmp.$rev_new $tmp.$rev_old";
}
}
elsif ($rev_old) {
write_file( "$tmp.$rev_old", scalar $vcs->cat($option{file}, $rev_old) );
if ($option{test} || $option{verbose}) {
print "$option{diff} $option{'file'} $tmp.$rev_old\n";
}
if (!$option{test}) {
exec "$option{diff} $option{'file'} $tmp.$rev_old";
}
}
else {
my $log = $vcs->log($option{file});
my ($ver) = max keys %$log;
my $rev = $log->{$ver}{rev} ? ".$log->{$ver}{rev}" : '';
write_file( "$tmp$rev", scalar $vcs->cat($option{file}) );
if ($option{test} || $option{verbose}) {
print "$option{diff} $option{'file'} $tmp$rev\n";
}
if (!$option{test}) {
exec "$option{diff} $option{'file'} $tmp$rev";
}
}
return;
}
sub write_file {
my ($file, @contents) = @_;
my $fh = file($file)->openw;
print {$fh} @contents;
close $fh;
}
__DATA__
=head1 NAME
vcsvimdiff - Uses vimdiff to compare a file with it unmodified version or
historic versions from subversion or bazaar.
=head1 VERSION
This documentation refers to vcsvimdiff version 0.4.0.
=head1 SYNOPSIS
vcsvimdiff [option] file
OPTIONS:
-r --revision=rev1[:rev2]
Specify revisions to use for full details see vcs help diff
-c --change=int
Specify changes from a specific revision (see vcs help diff)
-f --file=str Explisitly specify the file name
-R --replay Replay each change vs the current file
-m --max=int Maximum number of revisions to replay
-3 --three Three way diff for --replay, showing the file on disk, the
revision one newer than the current revision and the current
revision.
-p --previous
If set diff are between the revision currently being used and
the either the last looked revision or the file on disk
-t --test Turn on testing (vimdiff wont actually be run)
--no-test Trurn off testing
-d --diff=str Allows you to specify a diffing program (Default vimdiff)
-v --verbose Show more detailed option
--version Prints the version information
--help Prints this help information
--man Prints the full documentation for vcsvimdiff
=head1 DESCRIPTION
=head1 SUBROUTINES/METHODS
=head1 DIAGNOSTICS
=head1 CONFIGURATION AND ENVIRONMENT
=head1 DEPENDENCIES
=head1 INCOMPATIBILITIES
=head1 BUGS AND LIMITATIONS
There are no known bugs in this module.
Please report problems to Ivan Wills (ivan.wills@gmail.com).
Patches are welcome.
=head1 AUTHOR
Ivan Wills - (ivan.wills@gmail.com)
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2009 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW, 2077)
All rights reserved.
This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. See L<perlartistic>. 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.
=cut