Test::AutoBuild::Repository::Subversion - A repository for Subversion

  use Test::AutoBuild::Repository::Subversion

# -*- perl -*-
#
# Test::AutoBuild::Repository::Subversion by Daniel Berrange <dan@berrange.com>
#
# Copyright (C) 2002-2004 Daniel Berrange <dan@berrange.com>
#
# 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
#
# $Id: Subversion.pm,v 1.21 2007/12/08 21:01:19 danpb Exp $

package Test::AutoBuild::Repository::Subversion;

use base qw(Test::AutoBuild::Repository);
use strict;
use warnings;
use POSIX qw(strftime);
use Log::Log4perl;
use Test::AutoBuild::Change;
use Date::Manip;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@_);

    $self->{changelists} = {};

    bless $self, $class;

    return $self;
}


sub changelist {
    my $self = shift;
    my $runtime = shift;
    my $path = shift || "/";
    my $logfile = shift;

    my $timestamp = $runtime->timestamp;

    $self->{changelists}->{$timestamp} = {} unless defined $self->{changelists}->{$timestamp};

    if (!exists $self->{changelists}->{$timestamp}->{$path}) {
	$self->{changelists}->{$timestamp}->{$path} = $self->get_changelist($runtime, $path, $logfile);
    }
    return $self->{changelists}->{$timestamp}->{$path};
}

sub export {
    my $self = shift;
    my $runtime = shift;
    my $src = shift;
    my $dst = shift;
    my $logfile = shift;

    my $log = Log::Log4perl->get_logger();

    my $url = $self->option("url") or die "url option is required";
    $url =~ s,/$,,;

    my $date = strftime("{%Y-%m-%d %H:%M:%S +0000}", gmtime $runtime->timestamp);
    my $default = 0;
    my %changes;
    my $changed = 0;
    my $rev;
    if ($src =~ /^(.*?)(?:@(\d+))?\s*$/) {
	$src = $1;
	$rev = $2;
    }

    my $path = $url . "/" . $src;
    my $preRevision = -d $dst ? $self->current_revision($dst, $logfile) : undef;
    my ($output, $errors) =
	$self->_run(["svn", "checkout", "-r", $rev ? $rev : $date, $path, $dst], undef, $logfile);
    my $postRevision = $self->current_revision($dst, $logfile);

    if (defined $preRevision) {
	if ($preRevision  < $postRevision) {
	    $log->debug("Files updated, getting changes");
	    $self->get_changes($dst, \%changes, $preRevision+1, $postRevision, $logfile);
	    $changed = 1;
	} elsif ($preRevision != $postRevision) {
	    $log->debug("Files downgraded, skipping changes");
	    $changed = 1;
	} else {
	    $log->debug("Files unchanged");
	}
    } else {
	$log->debug("New checkout, skipping changes");
	$changed = 1;
    }

    return ($changed, \%changes);
}

sub current_revision {
    my $self = shift;
    my $path = shift;
    my $logfile = shift;

    my $log = Log::Log4perl->get_logger();

    $log->debug("Getting revision for path $path");
    my ($out, $errors) = $self->_run(["svn", "log", "-r", "COMMITTED", "-q", $path], undef, $logfile);
    my @lines = split /\n/, $out;
    if ($#lines != 2) {
	$log->error(@lines);
	die "expected 3 lines of log, got " . ($#lines +1);
    }
    if ($lines[1] !~ /^r(\d+)\s/) {
	die "cannot extract revision from log output '$lines[1]'";
    }
    return $1;
}


sub get_changelist {
    my $self = shift;
    my $runtime = shift;
    my $path = shift;
    my $logfile = shift;

    my $url = $self->option("url") or die "url option is required";
    $url .= $path;
    my $log = Log::Log4perl->get_logger();

    my $date = strftime("{%Y-%m-%d %H:%M:%S +0000}", gmtime $runtime->timestamp);

    $log->debug("Getting revision for path $path");
    my ($out, $errors) = $self->_run(["svn", "log", "-r", $date, "-q", $url], undef, $logfile);
    my @lines = split /\n/, $out;
    if ($#lines != 2) {
	$log->error(@lines);
	die "expected 3 lines of log, got " . ($#lines +1);
    }
    if ($lines[1] !~ /^r(\d+)\s/) {
	die "cannot extract revision from log output '$lines[1]'";
    }
    return $1;
}

sub get_changes {
    my $self = shift;
    my $path = shift;
    my $changes = shift;
    my $from = shift;
    my $to = shift;
    my $logfile = shift;

    my $log = Log::Log4perl->get_logger();

    $log->debug("Getting logs between $from and $to for $path");

    my ($out, $errors) = $self->_run(["svn", "log", "-v", "-r", "$from:$to", $path], undef, $logfile);
    my @entries = split /\n/, $out;
    shift @entries;
    while ($#entries != -1) {
	my @lines;
	while (defined (my $entry = shift @entries)) {
	    last if $entry =~ /^\s*\-+\s*$/;
	    push @lines, $entry;
	}
	my $change = $self->get_change(@lines);
	$changes->{$change->number} = $change;
    }
}

sub get_change {
    my $self = shift;
    my @lines = @_;

    my $meta = shift @lines;
    my $revision;
    my $author;
    my $datestr;
    my $tz;
    if ($meta =~ /^\s*r(\d+)\s*\|\s*(.*?)\s*\|\s*(.*?)\s+((?:\+|-)\d\d\d\d)\s*\(.*?\)\s*\|\s*(\d+)\s*line/) {
	$revision = $1;
	$author = $2;
	$datestr = $3;
	$tz = $4;
    } else {
	die "cannot extract revision metadata from log output '$meta'";
    }

    shift @lines; # 'Changed paths:'

    my @files;
    while (defined (my $entry = shift @lines)) {
	last if $entry =~ /^\s*$/;

	$entry =~ /^\s*(.*?)\s*$/;
	push @files, $1;
    }

    my $message = join ("\n", @lines);
    my $date = ParseDate($datestr);
    die "cannot parse date '$datestr'" unless defined $date;
    $date = Date_ConvTZ($date, $tz, "GMT");

    return Test::AutoBuild::Change->new(number => $revision,
					user => $author,
					date => UnixDate($date, "%o"),
					files => \@files,
					description => $message);
}

1 # So that the require or use succeeds.

__END__