#! /usr/bin/perl #--------------------------------------------------------------------- # $Id: svntag.pl 1949 2008-02-12 00:08:26Z cjm $ # Copyright 2007 Christopher J. Madsen # # This program is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. # # 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 either the # GNU General Public License or the Artistic License for more details. # # Create a tag in Subversion #--------------------------------------------------------------------- use strict; use warnings; use Cwd 'cwd'; use File::Temp 'tempdir'; use Getopt::Long 2.17; use SVN::Client; my $VERSION = join('', 'r', (q$Rev: 1949 $ =~ /(\d+)/)); my ($revision); Getopt::Long::Configure(qw(bundling no_getopt_compat)); GetOptions( 'revision|r=i' => \$revision, 'help|?' => \&usage, 'version' => \&usage ) or usage(); my ($tag, $url) = @ARGV; usage() unless defined($tag) and length $tag; sub usage { print "svntag $VERSION\n"; exit if $_[0] and $_[0] eq 'version'; print "\n" . <<'END HELP'; Usage: svntag [options] TAGNAME [PROJECT-URL] -r, --revision=REVNUM Tag revision REVNUM (default HEAD) -?, --help Display this help message --version Display version information The log message will be "Tagged MODULE TAGNAME (rREVNUM)". MODULE is the directory's 'module-name' Subversion property, or the directory name if the property isn't set. END HELP exit; } # end usage #--------------------------------------------------------------------- my $svn = SVN::Client->new(); $url = $svn->url_from_path(cwd) unless defined $url; my $module = $svn->propget('module-name', $url, 'HEAD', 0)->{$url}; $url =~ m!^(.+)/([^/]+)$! or die; $module = $2 unless defined $module; unless ($revision) { my $listing = $svn->ls($1, 'HEAD', 0); $revision = $listing->{$2}->created_rev; } # end unless specified revision my $logMsg = "Tagged $module $tag (r$revision)"; $svn->log_msg(sub { ${$_[0]} = $logMsg }); my $tagURL = $url; $tagURL =~ s!/trunk/!/tags/! or die; my $newURL = "$tagURL/$tag"; #--------------------------------------------------------------------- # First, try a simple copy: print "svn copy -r $revision $url\n $newURL\n"; eval { $svn->copy($url, $revision, $newURL); print "$logMsg\n"; }; exit unless $@; die $@ unless $@ =~ /^Name does not refer to a filesystem directory/ or $@ =~ /^HTTP Path Not Found/; #--------------------------------------------------------------------- # If that fails, assume we need to create the module directory: print "Creating $tagURL...\n"; my $tmpDir = tempdir(CLEANUP => 1); my ($tagRoot, $moduleDir) = ($tagURL =~ m!^(.+)/([^/]+)$!) or die; $svn->checkout($tagRoot, $tmpDir, 'HEAD', 0); $svn->mkdir("$tmpDir/$moduleDir"); $svn->copy($url, $revision, "$tmpDir/$moduleDir/$tag"); $svn->commit($tmpDir, 0); print "$logMsg\n";