package Module::Release::SVN;

use strict;
use warnings;
use base qw(Exporter);
use vars qw($VERSION);

use Carp;

our @EXPORT = qw(check_vcs vcs_tag make_vcs_tag);

$VERSION = '2.06';

=head1 NAME

Module::Release::SVN - Use Subversion with Module::Release

=head1 SYNOPSIS

The release script automatically loads this module if it sees a
F<.svn> directory. The module exports check_cvs, cvs_tag, and make_cvs_tag.

=head1 DESCRIPTION

C<Module::Release::SVN> is a plugin for C<Module::Release>, and provides
its own implementations of the C<check_vcs()> and C<vcs_tag()> methods
that are suitable for use with a Subversion repository rather than a
CVS repository.

These methods are B<automatically> exported in to the callers namespace
using Exporter. You should only use it from C<Module::Release> or its
subclasses.

This module depends on the external svn binary (so far).

=cut

=over 4

=item C<check_cvs()>

DEPRECATED. Use C<check_vcs> now.

=item C<check_vcs()>

Check the state of the SVN repository.

=cut

sub check_cvs
	{
	carp "check_cvs is deprecated in favor of check_vcs. Update your programs!";
	&check_vcs;
	}

sub check_vcs
	{
	my $self = shift;

	$self->_print( "Checking state of Subversion..." );

	my $svn_update = $self->run('svn status --show-updates --verbose 2>&1');

	$self->_die(
		sprintf("\nERROR: svn failed with non-zero exit status: %d\n\n"
			. "Aborting release\n", $? >> 8)
		) if $?;

	$svn_update =~ s/^\?\s+/?/;
	$svn_update =~ s/^(........)\s+\d+\s+\d+\s+\S+\s+(.*)$/$1 $2/mg;

	my %message = (
		qr/^C......./m   => 'These files have conflicts',
		qr/^M......./m   => 'These files have not been checked in',
		qr/^........\*/m => 'These files need to be updated',
		qr/^P......./m   => 'These files need to be patched',
		qr/^A......./m   => 'These files were added but not checked in',
		qr/^D......./m   => 'These files are scheduled for deletion',
		qr/^\?......./m  => 'I don\'t know about these files',
		);

	my @svn_states = keys %message;

	my %svn_state;
	foreach my $state (@svn_states)
		{
		$svn_state{$state} = [ $svn_update =~ /$state\s+(.*)/g ];
		}

	my $count;
	my $question_count;

	foreach my $key ( sort keys %svn_state )
		{
		my $list = $svn_state{$key};
		next unless @$list;

		$count          += @$list unless $key eq qr/^\?......./;
		$question_count += @$list if     $key eq qr/^\?......./;

		local $" = "\n\t";
		$self->_print( "\n\t$message{$key}\n", "-" x 50, "\n\t@$list\n" );
		}

	$self->_die( "\nERROR: Subversion is not up-to-date ($count files): Can't release!\n" )
    	if $count;

=pod

	if($question_count)
		{
    	$self->_print "\nWARNING: Subversion is not up-to-date ($question_count files unknown); ",
      "continue anwyay? [Ny] " ;
		die "Exiting\n" unless <> =~ /^[yY]/;
		}

=cut

	$self->_print( "Subversion up-to-date\n" );
	}

=item C<cvs_tag()>

DEPRECATED. Use C<vcs_tag> now.

=item C<vcs_tag(TAG)>

Tag the release in Subversion.

=cut


sub cvs_tag
	{
	carp "cvs_tag is deprecated in favor of vcs_tag. Update your programs!";
	&check_vcs;
	}

sub vcs_tag
	{
	require URI;

	my $self = shift;

	my $svn_info = $self->run('svn info .');

	if($?)
		{
		$self->_warn(
			sprintf(
				"\nWARNING: 'svn info .' failed with non-zero exit status: %d\n",
				$? >> 8 )
			);

		return;
		}

	$svn_info =~ /^URL: (.*)$/m;
	my $trunk_url = URI->new( $1 );

	my @tag_url = $trunk_url->path_segments;
	if(! grep /^trunk$/, @tag_url )
		{
		$self->_warn(
			"\nWARNING: Current SVN URL:\n  $trunk_url\ndoes not contain a 'trunk' component\n",
			"Aborting tagging.\n"
			);

		return;
		}

	foreach( @tag_url )
		{
		if($_ eq 'trunk')
			{
			$_ = 'tags';
			last;
			}
		}

	my $tag_url = $trunk_url->clone;

	$tag_url->path_segments( @tag_url );

	# Make sure the top-level path exists
	#
	# Can't use $self->run() because of a bug where $fh isn't closed, which
	# stops $? from being properly propogated.  Reported to brian d foy as
	# part of RT#6489
	$self->run( "svn list $tag_url 2>&1" );
	if( $? )
		{
		$self->_warn(
			sprintf("\nWARNING:\n  svn list $tag_url\nfailed with non-zero exit status: %d\n", $? >> 8),
			"Assuming tagging directory does not exist in repo.  Please create it.\n",
			"Aborting tagging.\n"
			);

		return;
		}

	my $tag = $self->make_vcs_tag;

	push @tag_url, $tag;
	$tag_url->path_segments(@tag_url);
	$self->_print( "Tagging release to $tag_url\n" );

	$self->run( "svn copy $trunk_url $tag_url" );

	if ( $? )
		{
		# already uploaded, and tagging is not (?) essential, so warn, don't die
		$self->_warn(
			sprintf(
				"\nWARNING: svn failed with non-zero exit status: %d\n",
				$? >> 8 )
			);
		}

	}

=item C<make_cvs_tag()>

DEPRECATED. Use C<make_vcs_tag> now.

=item make_vcs_tag

By default, examines the name of the remote file
(i.e. F<Foo-Bar-0.04.tar.gz>) and constructs a tag string like
C<RELEASE_0_04> from it.  Override this method if you want to use a
different tagging scheme, or don't even call it.

=cut


sub make_cvs_tag
	{
	carp "make_cvs_tag is deprecated in favor of make_vcs_tag. Update your programs!";
	&make_vcs_tag;
	}

sub make_vcs_tag
	{
	my $self = shift;
	my( $major, $minor ) = $self->remote_file
		=~ /(\d+) \. (\d+(?:_\d+)?) (?:\. tar \. gz)? $/xg;

	return "RELEASE_${major}_${minor}";
	}

=back

=head1 SEE ALSO

L<Module::Release>

=head1 SOURCE AVAILABILITY

This source is in Github:

	git://github.com/briandfoy/module-release.git

=head1 AUTHOR

brian d foy, C<< <bdfoy@cpan.org> >>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2007-2011, brian d foy, All Rights Reserved.

You may redistribute this under the same terms as Perl itself.

=cut

1;