1use v5.16;
2
3package Module::Release::SVN;
4
5use strict;
6use warnings;
7use Exporter qw(import);
8
9use Carp;
10
11our @EXPORT = qw(check_vcs vcs_tag make_vcs_tag);
12
13our $VERSION = '2.128';
14
15=encoding utf8
16
17=head1 NAME
18
19Module::Release::SVN - Use Subversion with Module::Release
20
21=head1 SYNOPSIS
22
23The release script automatically loads this module if it sees a
24F<.svn> directory. The module exports check_cvs, cvs_tag, and make_cvs_tag.
25
26=head1 DESCRIPTION
27
28C<Module::Release::SVN> is a plugin for C<Module::Release>, and provides
29its own implementations of the C<check_vcs()> and C<vcs_tag()> methods
30that are suitable for use with a Subversion repository rather than a
31CVS repository.
32
33These methods are B<automatically> exported in to the callers namespace
34using Exporter. You should only use it from C<Module::Release> or its
35subclasses.
36
37This module depends on the external svn binary (so far).
38
39=cut
40
41=over 4
42
43=item C<check_cvs()>
44
45DEPRECATED. Use C<check_vcs> now.
46
47=item C<check_vcs()>
48
49Check the state of the SVN repository.
50
51=cut
52
53sub check_cvs {
54	carp "check_cvs is deprecated in favor of check_vcs. Update your programs!";
55	&check_vcs;
56	}
57
58sub check_vcs {
59	my $self = shift;
60
61	$self->_print( "Checking state of Subversion..." );
62
63	my $svn_update = $self->run('svn status --show-updates --verbose 2>&1');
64
65	$self->_die(
66		sprintf("\nERROR: svn failed with non-zero exit status: %d\n\n"
67			. "Aborting release\n", $? >> 8)
68		) if $?;
69
70	$svn_update =~ s/^\?\s+/?/;
71	$svn_update =~ s/^(........)\s+\d+\s+\d+\s+\S+\s+(.*)$/$1 $2/mg;
72
73	my %message = (
74		qr/^C......./m   => 'These files have conflicts',
75		qr/^M......./m   => 'These files have not been checked in',
76		qr/^........\*/m => 'These files need to be updated',
77		qr/^P......./m   => 'These files need to be patched',
78		qr/^A......./m   => 'These files were added but not checked in',
79		qr/^D......./m   => 'These files are scheduled for deletion',
80		qr/^\?......./m  => 'I don\'t know about these files',
81		);
82
83	my @svn_states = keys %message;
84
85	my %svn_state;
86	foreach my $state (@svn_states) {
87		$svn_state{$state} = [ $svn_update =~ /$state\s+(.*)/g ];
88		}
89
90	my $count;
91	my $question_count;
92
93	foreach my $key ( sort keys %svn_state ) {
94		my $list = $svn_state{$key};
95		next unless @$list;
96
97		$count          += @$list unless $key eq qr/^\?......./;
98		$question_count += @$list if     $key eq qr/^\?......./;
99
100		local $" = "\n\t";
101		$self->_print( "\n\t$message{$key}\n", "-" x 50, "\n\t@$list\n" );
102		}
103
104	$self->_die( "\nERROR: Subversion is not up-to-date ($count files): Can't release!\n" )
105    	if $count;
106
107=pod
108
109	if($question_count)
110		{
111    	$self->_print "\nWARNING: Subversion is not up-to-date ($question_count files unknown); ",
112      "continue anyway? [Ny] " ;
113		die "Exiting\n" unless <> =~ /^[yY]/;
114		}
115
116=cut
117
118	$self->_print( "Subversion up-to-date\n" );
119	}
120
121=item C<cvs_tag()>
122
123DEPRECATED. Use C<vcs_tag> now.
124
125=item C<vcs_tag(TAG)>
126
127Tag the release in Subversion.
128
129=cut
130
131
132sub cvs_tag {
133	carp "cvs_tag is deprecated in favor of vcs_tag. Update your programs!";
134	&check_vcs;
135	}
136
137sub vcs_tag {
138	require URI;
139
140	my $self = shift;
141
142	my $svn_info = $self->run('svn info .');
143
144	if($?)
145		{
146		$self->_warn(
147			sprintf(
148				"\nWARNING: 'svn info .' failed with non-zero exit status: %d\n",
149				$? >> 8 )
150			);
151
152		return;
153		}
154
155	$svn_info =~ /^URL: (.*)$/m;
156	my $trunk_url = URI->new( $1 );
157
158	my @tag_url = $trunk_url->path_segments;
159	if(! grep /^trunk$/, @tag_url ) {
160		$self->_warn(
161			"\nWARNING: Current SVN URL:\n  $trunk_url\ndoes not contain a 'trunk' component\n",
162			"Aborting tagging.\n"
163			);
164
165		return;
166		}
167
168	foreach( @tag_url ) {
169		if($_ eq 'trunk') {
170			$_ = 'tags';
171			last;
172			}
173		}
174
175	my $tag_url = $trunk_url->clone;
176
177	$tag_url->path_segments( @tag_url );
178
179	# Make sure the top-level path exists
180	#
181	# Can't use $self->run() because of a bug where $fh isn't closed, which
182	# stops $? from being properly propagated.  Reported to brian d foy as
183	# part of RT#6489
184	$self->run( "svn list $tag_url 2>&1" );
185	if( $? ) {
186		$self->_warn(
187			sprintf("\nWARNING:\n  svn list $tag_url\nfailed with non-zero exit status: %d\n", $? >> 8),
188			"Assuming tagging directory does not exist in repo.  Please create it.\n",
189			"Aborting tagging.\n"
190			);
191
192		return;
193		}
194
195	my $tag = $self->make_vcs_tag;
196
197	push @tag_url, $tag;
198	$tag_url->path_segments(@tag_url);
199	$self->_print( "Tagging release to $tag_url\n" );
200
201	$self->run( "svn copy $trunk_url $tag_url" );
202
203	if ( $? ) {
204		# already uploaded, and tagging is not (?) essential, so warn, don't die
205		$self->_warn(
206			sprintf(
207				"\nWARNING: svn failed with non-zero exit status: %d\n",
208				$? >> 8 )
209			);
210		}
211
212	}
213
214=item C<make_cvs_tag()>
215
216DEPRECATED. Use C<make_vcs_tag> now.
217
218=item make_vcs_tag
219
220By default, examines the name of the remote file
221(i.e. F<Foo-Bar-0.04.tar.gz>) and constructs a tag string like
222C<RELEASE_0_04> from it.  Override this method if you want to use a
223different tagging scheme, or don't even call it.
224
225=cut
226
227
228sub make_cvs_tag {
229	carp "make_cvs_tag is deprecated in favor of make_vcs_tag. Update your programs!";
230	&make_vcs_tag;
231	}
232
233sub make_vcs_tag {
234	my $self = shift;
235	my( $major, $minor ) = $self->remote_file
236		=~ /(\d+) \. (\d+(?:_\d+)?) (?:\. tar \. gz)? $/xg;
237
238	return "RELEASE_${major}_${minor}";
239	}
240
241sub vcs_exit { 1 }
242
243=back
244
245=head1 SEE ALSO
246
247L<Module::Release>
248
249=head1 SOURCE AVAILABILITY
250
251This source is in GitHub
252
253	https://github.com/briandfoy/module-release
254
255=head1 AUTHOR
256
257brian d foy, C<< <bdfoy@cpan.org> >>
258
259=head1 COPYRIGHT AND LICENSE
260
261Copyright © 2007-2021, brian d foy C<< <bdfoy@cpan.org> >>. All rights reserved.
262
263This program is free software; you can redistribute it and/or modify
264it under the Artistic License 2.0.
265
266=cut
267
2681;
269