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