# -*- perl -*- # # Test::AutoBuild::Repository::Subversion by Daniel Berrange # # Copyright (C) 2002-2004 Daniel Berrange # # 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$ =pod =head1 NAME Test::AutoBuild::Repository::Subversion - A repository for Subversion =head1 SYNOPSIS use Test::AutoBuild::Repository::Subversion =head1 DESCRIPTION Description =head1 METHODS =over 4 =cut 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; =item my $repository = AutoBuild::Repository::Subversion->new(); =cut 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"); $date = $date . "+0000"; return Test::AutoBuild::Change->new(number => $revision, user => $author, date => UnixDate($date, "%s"), files => \@files, description => $message); } 1 # So that the require or use succeeds. __END__ =back =head1 AUTHORS Daniel Berrange =head1 COPYRIGHT Copyright (C) 2002-2004 Daniel Berrange =head1 SEE ALSO C, L =cut