#! /usr/local/bin/perl
#---------------------------------------------------------------------
# $Id: svntag.pl 2781 2014-05-17 16:51:08Z cjm $
# Copyright 2007 Christopher J. Madsen <perl@cjmweb.net>
#
# 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 List::Util 'reduce';
use SVN::Client;

my $VERSION = join('', 'r', (q$Rev: 2781 $ =~ /(\d+)/));

my ($revision, $showCurrent);

Getopt::Long::Configure(qw(bundling no_getopt_compat));
GetOptions(
    'show-current|s'=> \$showCurrent,
    'revision|r=i'  => \$revision,
    'help|?'        => \&usage,
    'version'       => \&usage
) or usage();

my ($tag, $url) = @ARGV;

$showCurrent = 1 unless defined($tag) and length $tag;

$url = $tag if $showCurrent;

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)
  -s, --show-current     Show most recent tag
  -?, --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 $tagURL = $url;
$tagURL =~ s!/trunk/!/tags/! or die;

if ($showCurrent) {
  my $listing = $svn->ls($tagURL, 'HEAD', 0);

  my $currentTag = reduce {
    $listing->{$a}->created_rev < $listing->{$b}->created_rev
        ? $b : $a
  } keys %$listing;

  my ($message) = $svn->revprop_get('svn:log', $url,
                                    $listing->{$currentTag}->created_rev);
  print "$currentTag: $message\n";
  exit;
} # end if $showCurrent

#---------------------------------------------------------------------
# Otherwise, we're tagging a new version:

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 $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";