package Shipwright::Backend::SVN; use warnings; use strict; use File::Spec::Functions qw/catfile/; use Shipwright::Util; use File::Copy::Recursive qw/rcopy/; our %REQUIRE_OPTIONS = ( import => [qw/source/] ); use base qw/Shipwright::Backend::Base/; =head1 NAME Shipwright::Backend::SVN - SVN repository backend =head1 SYNOPSIS svnadmin create /home/me/shipwright/my_proj shipwright create -r svn:file:///home/me/shipwright/my_proj =head1 DESCRIPTION This module implements a SVN based backend for Shipwright L. =head1 ENVIRONMENT VARIABLES =over 4 =item SHIPWRIGHT_SVN - path of F command, default value is F. F command is expected to be in the same directory as F. =back =head1 METHODS =over 4 =item build =cut sub build { my $self = shift; $self->strip_repository if $self->repository =~ m{^svn:[a-z]+(?:\+[a-z]+)?://}; $self->SUPER::build(@_); } =item initialize initialize a project. =cut sub initialize { my $self = shift; my $dir = $self->SUPER::initialize(@_); $self->delete; # clean repository in case it exists $self->import( source => $dir, _initialize => 1, comment => 'created project', ); $self->_initialize_local_dir(); } =item import =cut sub import { my $self = shift; return unless ref $self; # get rid of class->import return $self->SUPER::import( @_, delete => 1 ); } # a cmd generating factory sub _cmd { my $self = shift; my $type = shift; my %args = @_; $args{path} ||= ''; $args{comment} ||= ''; for ( @{ $REQUIRE_OPTIONS{$type} } ) { confess_or_die "$type need option $_" unless $args{$_}; } my @cmd; if ( $type eq 'checkout' ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'checkout', $self->repository . $args{path}, $args{target} ]; } elsif ( $type eq 'export' ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'export', $self->repository . $args{path}, $args{target} ]; } elsif ( $type eq 'import' ) { if ( $args{_initialize} ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'import', $args{source}, $self->repository . ( $args{path} || '' ), '-m', $args{comment}, ]; } elsif ( $args{_extra_tests} ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'import', $args{source}, $self->repository . '/t/extra', '-m', $args{comment}, ]; } else { if ( my $script_dir = $args{build_script} ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'import', $script_dir, $self->repository . "/scripts/$args{name}/", '-m', $args{comment}, ]; } else { if ( $self->has_branch_support ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'import', $args{source}, $self->repository . "/sources/$args{name}/$args{as}", '-m', $args{comment}, ]; } else { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'import', $args{source}, $self->repository . "/dists/$args{name}", '-m', $args{comment}, ]; } } } } elsif ( $type eq 'list' ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'list', $self->repository . $args{path} ]; } elsif ( $type eq 'commit' ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'commit', '-m', $args{comment}, $args{path} ]; } elsif ( $type eq 'delete' ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'delete', '-m', 'delete ' . $args{path}, $self->repository . $args{path}, ]; } elsif ( $type eq 'move' ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'move', '-m', "move $args{path} to $args{new_path}", $self->repository . $args{path}, $self->repository . $args{new_path} ]; } elsif ( $type eq 'info' ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'info', $self->repository . $args{path} ]; } elsif ( $type eq 'cat' ) { @cmd = [ $ENV{'SHIPWRIGHT_SVN'}, 'cat', $self->repository . $args{path} ]; } else { confess_or_die "invalid command: $type"; } return @cmd; } sub _yml { my $self = shift; my $path = shift; my $yml = shift; my $file = $self->local_dir . $path; if ($yml) { if ( $path =~ /scripts/ ) { $self->_sync_local_dir('/scripts'); } else { $self->_sync_local_dir($path); } dump_yaml_file( $file, $yml ); $self->commit( path => $file, comment => "updated $path" ); } else { my ($out) = run_cmd( [ $ENV{'SHIPWRIGHT_SVN'}, 'cat', $self->repository . $path ] ); return load_yaml($out); } } =item info a wrapper around svn's info command. =cut sub info { my $self = shift; my ( $info, $err ) = $self->SUPER::info(@_); if (wantarray) { return $info, $err; } else { if ($err) { $err =~ s/\s+$//; $self->log->warn($err); return; } return $info; } } =item check_repository check if the given repository is valid. =cut sub check_repository { my $self = shift; my %args = @_; if ( $args{action} eq 'create' ) { my ( $info, $err ) = $self->info; my $repo = $self->repository; # $err like # file:///tmp/svn/foo: (Not a valid URL) # usually means foo doesn't exist, which is valid for create if ($info) { return 1 if $args{force} || $info =~ /Revision: 0/; $self->log->fatal("$repo has commits already"); return; } return 1 if $err && $err =~ m{^\Q$repo\E:}m; } else { return $self->SUPER::check_repository(@_); } return; } sub _update_file { my $self = shift; my $path = shift; my $latest = shift; $self->_sync_local_dir( $path ); my $file = $self->local_dir . $path; rcopy( $latest, $file ) or confess_or_die "can't copy $latest to $file: $!"; $self->commit( path => $file, comment => "updated $path", ); } sub _update_dir { my $self = shift; my $path = shift; my $latest = shift; $self->delete( path => $path ); $self->import( path => $path, source => $latest, _initialize => 1 ); } sub _initialize_local_dir { my $self = shift; # the 0 is very important, or it may results in recursion my $target = $self->local_dir( 0 ); remove_tree( $target ) if -e $target; run_cmd( [ $ENV{'SHIPWRIGHT_SVN'}, 'checkout', $self->repository, $target ] ); return $target; } sub _sync_local_dir { my $self = shift; my $path = shift || ''; run_cmd( [ $ENV{'SHIPWRIGHT_SVN'}, 'update', $self->local_dir . $path ], 1 ); } =back =cut 1; __END__ =head1 AUTHORS sunnavy C<< >> =head1 LICENCE AND COPYRIGHT Shipwright is Copyright 2007-2012 Best Practical Solutions, LLC. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.