#!/usr/bin/perl

# svn wrapper
# use a versioned property for modified files' mtime
# 2007-May-28 A. L. Taurog

# caution from Oliver Betz:
# - stat() fails on filenames with foreign characters.
# maybe conflicting translations from svn and perl?
# - (stat())->mtime reports wrong data using ActivePerl with NTFS. Cygwin works.

use strict;
use File::stat;
use Time::Local;

$ENV{Lang}="C";

my $subcommand = $ARGV[0];

if ($subcommand =~ /^(?:up|update|switch|sw|merge|export|checkout|co|revert)$/)
{
    # primitive protection of arguments.
    # this won't work for args with double quotes in them 
    # (and will crash if they aren't matched)
    open FH, 'svn "' . join('" "', @ARGV) . '"|' 
        or die "couldn't create svn process: $!\n";

    my @files;

    # -q will mess this up
    while (<FH>)
    {
        print;

        # don't update times for G (merged), D (deleted) or C (conflict)
        if (/^[AU]{1,2} +(.*)|^Re(?:verted|stored) '(.*)'/)
        {
            push @files, $1;
        }
    }

    close FH;

    print "resetting mtimes...\n";

    map s/\r//, @files;
    foreach my $file (@files)
    {
        my $mtime = gettime($file);
        if ($mtime)
        {
            print "$file\n";
            utime time, $mtime, $file or warn "couldn't reset mtime for file $file: $!\n";
        }
    }
    exit;
}

if ($subcommand eq "commit")
{
    # get modified, added, or replaced files.
    # casts a broader net than necessary, but probably won't hurt
    my @svnstat = grep /^[MAR]/, `svn stat -q`; # response of "svn stat"

    my @files = map substr($_,7), @svnstat; 
    map s/\r\n//, @files;

    foreach my $file (@files)
    {
        my $timestamp = svntime($file);
        print `svn propset alt:mtime $timestamp "$file"`;
    }
}

my @command = ("svn", @ARGV);
exec @command;

# takes filename as input, returns mtime using the
# special format of svn time: 2005-07-11T09:17:35.000000Z
sub svntime 
{
    my $file = shift;
    my $mtime = eval { (stat($file))->mtime };
    warn $@ and return if $@;

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($mtime);
    return sprintf "%4d-%02d-%02dT%02d:%02d:%02d.000000Z",
                 1900+$year,$mon+1,$mday,$hour,$min,$sec;
}

sub gettime 
{
    my $file = shift;
    my ($propline) = grep /alt:mtime/, `svn proplist -v "$file"`;
    return 0 if not defined $propline;

    my ($year, $mon, $day, $hour, $min, $sec) 
        = ($propline =~ m/: (\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)/g);
    $year -= 1900;
    $mon--;
    return timegm($sec, $min, $hour, $day, $mon, $year);
}

__END__ 

=head1 Name

svm - a wrapper script for mtime-maintaining svn operations 

=head1 Synopsis

    svm checkout [args] <url> <path>
    svm commit [args] <file>
    svm switch | update | merge [args]
    svm export [args]

=head1 Description

B<svm> is a perl wrapper for svm which preserves file mtimes

=head1 See Also

L<<a href="http://www.aryehleib.com/MergeSvnDumps.html">http://www.aryehleib.com/MergeSvnDumps.html</a>>
L<<a href="http://www.aryehleib.com/_subversion_mtimes.html">http://www.aryehleib.com/_subversion_mtimes.html</a>>

=head1 Copyright

Copyright 2007 Aryeh Leib Taurog    www.aryehleib.com

This is free software.  It is available under the same license as Perl.

This software is provided AS IS with no warranty as to its usability or 
fitness for any purpose. I disclaim all responsibility for any damage 
whatsoever resulting from the download or use of this software.

=cut