#!/usr/local/perl-5.8.0/bin/perl -w
use strict;
use warnings;
use Date::Parse qw( str2time );
use Text::Glob qw( glob_to_regex );
use File::Spec::Functions qw( catfile splitpath );
use File::Copy ();
use File::Find::Rule;

use vars qw($VERSION);
$VERSION = 0.04;

=head1 NAME

cvn - a unified wrapper around cvs and svn

=head1 SYNOPSIS

cvn [cvs|svn command here]

=head1 DESCRIPTION

C<cvn> at its simplest provides a way to automatically invoke either
the svn of cvs binary, depending on whether the current working
directory is held under CVS or Subversion.

It also simulates some commands in the cases (eg cvs doesn't support
C<st> or offline diffing) where one of the apps is deficient (where
possible)

=head1 Notes on simulated commands

=cut

# parse and cache the .cvsignore and CVS/Entries files on first hit
# per directory

my %ignores;
sub is_ignored {
    my (undef, $dir, $name) = splitpath( shift );
    unless ($ignores{ $dir }) {
        $ignores{ $dir } = [];
        open my $fh, catfile($dir ? $dir : (), ".cvsignore") or return;
        $ignores{ $dir } = [ map { chomp; glob_to_regex $_ } <$fh> ];
    }
    return grep { $name =~ /$_/ } @{ $ignores{ $dir } };
}

my %entries;
sub get_entry {
    my (undef, $dir, $name) = splitpath( shift );
    unless ($entries{ $dir }) {
        $entries{ $dir } = {};
        open my $fh, catfile($dir ? $dir : (), "CVS", "Entries") or return;
        while (<$fh>) {
            chomp;
            next if $_ eq 'D';
            my %field;
            @field{qw( dir name version modified bar baz )} = split /\//, $_;
            $field{mtime} = str2time $field{modified}, "UTC"
              unless $field{dir};
            $field{path} = catfile( $dir ? $dir : (), $field{name} );
            $entries{ $dir }{ $field{name} } = \%field;
        }
    }
    return $entries{ $dir }{ $name };
}

sub dir_entries {
    my $dir = shift;
    local *D;
    opendir D, $dir;
    map { $dir eq '.' ? $_ : "$dir/$_" } grep { !/^\.\.?$/ } readdir D;
}

# wander the tree like CVS would, invoking a callback along the way
sub walk_cvslike {
    my $callback = pop @_;

    my @what = @_ ? @_ : dir_entries('.');
    for my $file ( @what ) {
        next if -d $file && $file =~ m/\bCVS$/;
        my $entry = get_entry( $file );

        if ($entry && $entry->{dir}) {
            push @what, dir_entries($file);
            next;
        };
        $callback->($file, %{ $entry || {} });
    }
}


my %simulated;

=head2 C<st>

simulated under CVS by comparing the server-modified date in
CVS/Entries with the mtime of the file(s)

=cut

$simulated{cvs}{st} = sub {
    if (@_ && $_[0] eq '-v') {
        print "$0: can't emulate st -v under CVS\n";
        exit 1;
    }

    walk_cvslike( @_,
                  sub {
                      my ($file, %entry) = @_;
                      unless (%entry) {
                          return if is_ignored( $file );
                          print "? $file\n"; return;
                      }
                      unless ($entry{version}) {
                          print "A $file\n"; return;
                      }
                      if ((stat $file)[9] > $entry{mtime}) {
                          print "M $file\n"; return;
                      }
                  }
                );
    return 0;
};

sub _text_name {
    my %entry = @_;
    my $dir = (splitpath $entry{path})[1];
    catfile( $dir ? $dir : (), "CVS", "text_$entry{name}_$entry{version}" );
}

=head2 C<get_texts>

keep texts in CVS/text_$file_$rev - used for offline diffing

=cut

$simulated{svn}{get_texts} = sub { 0 };
$simulated{cvs}{get_texts} = sub {
    walk_cvslike( @_,
                  sub {
                      my ($file, %entry) = @_;
                      return unless %entry;
                      my $text = _text_name( %entry );
                      next if -e $text;

                      # XXX added files need loving here
                      if ((stat $file)[9] > $entry{mtime}) {
                          # we seem to have local mods, pull from the repository
                          `cvs up -p -r $entry{version} $file > $text 2> /dev/null`;
                      }
                      else {
                          File::Copy::copy($file, $text);
                      }
                      # touch it back
                      utime $entry{mtime}, $entry{mtime}, $text;
                  }
                );
};

=head2 C<up>

extended for CVS to invoke C<get_texts> automatically

=cut

$simulated{cvs}{up} = sub {
    system 'cvs', 'up', @_;
    $simulated{cvs}{get_texts}->(@_);
};

=head2 C<diff>

extended for CVS to attempt to use the locally cached text(s)

=cut

$simulated{cvs}{diff} = sub {
    walk_cvslike( @_,
                  sub {
                      my ($file, %entry) = @_;
                      return unless %entry;
                      my $text = _text_name( %entry );
                      if (-e $text) {
                          system 'diff', '-u', $text, $file;
                      }
                      else {
                          print "Diffing against server for $file\n";
                          system 'cvs', 'diff', '-u', $file;
                      }
                  }
                );
};


=head2 C<revert>

extended for CVS to attempt to use the locally cached text(s)

=cut

$simulated{cvs}{revert} = sub {
    walk_cvslike( @_,
                  sub {
                      my ($file, %entry) = @_;
                      return unless $entry{mtime};
                      return unless (stat $file)[9] > $entry{mtime};
                      print "Reverting: $file\n";
                      my $text = _text_name( %entry );
                      if (-e $text) {
                          File::Copy::copy($text, $file);
                      }
                      else {
                          `cvs up -p -r $entry{version} $file > $file`;
                      }
                      # touch it back so we know it's good
                      utime $entry{mtime}, $entry{mtime}, $file;
                  }
                );
};

=head2 C<rgrep>

simulated in both.  similar to rgrep(1), but deliberately ignores
files in .svn and CVS directories.

=cut

$simulated{all}{rgrep} = sub {
    # args parsing is tricky - let's go shopping!
    my (@switches, $pattern, $no_more_switches);
    while (@_) {
        local $_ = shift;
        if (/^--$/)                       { $no_more_switches = 1; next }
        if (!$no_more_switches && /^-/)   { push @switches, $_;    next }
        $pattern = $_; last;
    }

    die "no pattern" unless defined $pattern;

    if (-e '.svn') { # subversion, just don't peek in .svn
        for my $file ( find( or => [ rule( directory =>
                                           name => '.svn',
                                           prune => discard => ),
                                     rule( file => ) ],
                             in => @_ ? @_ : '.' ) ) {
            system 'grep', '-H', @switches, '--', $pattern, $file;
        }
        return 0;
    }

    # if we made it this far, it's CVS
    walk_cvslike( @_,
                  sub {
                      my $file = shift;
                      system 'grep', '-H', @switches, '--', $pattern, $file;
                  } );
    0;
};

=head2 C<version>

simulated in both to return the version of the cvn binary

=cut

$simulated{all}{version} = sub {
    print "cvn version $VERSION\n";
    return 0;
};

sub simulate {
    my $app = shift;
    my $cmd = shift;
    my $sub = $simulated{ $app || '' }{ $cmd }
      ||      $simulated{ 'all' }{ $cmd }
      || return;
    exit $sub->(@_);
}

my $command;
$command ||= 'svn' if -d '.svn';
$command ||= 'cvs' if -d 'CVS';

simulate $command, @ARGV;

unless ( $command ) {
    print "svn: current directory isn't under vcs\n";
    exit 1;
}
exec     $command, @ARGV;

=head1 TODO

have rgrep honour svnignore property (currently it just
excludes things inside .svn dirs for subversion)

improve parameter parsing

improve documentation

be a little more paranoid about invoking commands

=head1 CAVEATS

C<rgrep> invokes grep with the -H option, which may not be supported
by your native version of grep

=head1 AUTHOR

Richard Clamp <richardc@unixbeard.net>

=head1 COPYRIGHT

Copyright (C) 2002 Richard Clamp.  All Rights Reserved.

This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut