LCFG::Build::VCS::SVN - LCFG build tools for subversion version-control

    LCFG::Build::VCS::SVN - LCFG build tools for subversion version-control

    This documentation refers to LCFG::Build::VCS::SVN version 0.0.33

    my $dir = ".";

    my $spec = LCFG::Build::PkgSpec->new_from_metafile("$dir/lcfg.yml");

    my $vcs = LCFG::Build::VCS::SVN->new( module  => $spec->fullname,
                                          workdir => $dir );

    $vcs->genchangelog();

    if ( $vcs->checkcommitted() ) {
      $vcs->tagversion();
    }

    Stephen Quinney <squinney@inf.ed.ac.uk>

package LCFG::Build::VCS::SVN; # -*-perl-*-
use strict;
use warnings;

# $Id: SVN.pm.in 3731 2009-03-25 16:26:01Z squinney@INF.ED.AC.UK $
# $Source: /var/cvs/dice/LCFG-Build-VCS/lib/LCFG/Build/VCS/SVN.pm.in,v $
# $Revision: 3731 $
# $HeadURL: https://svn.lcfg.org/svn/source/tags/LCFG-Build-VCS/LCFG_Build_VCS_0_0_33/lib/LCFG/Build/VCS/SVN.pm.in $
# $Date: 2009-03-25 16:26:01 +0000 (Wed, 25 Mar 2009) $

our $VERSION = '0.0.33';

use File::Path ();
use File::Spec ();
use IPC::Run qw(run);
use IO::File qw(O_WRONLY O_CREAT O_NONBLOCK O_NOCTTY);

use Moose;

with 'LCFG::Build::VCS';

has '+binpath' => ( default => '/usr/bin/svn' );

has '+id' => ( default => 'SVN' );

no Moose;
__PACKAGE__->meta->make_immutable;

sub get_info {
    my ( $self, $infokey, $directory ) = @_;

    if ( !defined $directory ) {
        $directory = $self->workdir;
    }

    my @info = $self->run_infocmd( 'info', $directory );

    for my $line (@info) {
        if ( $line =~ m/^
                                                ([^:]+)  # key
                                                :
                                                \s+
                                                (.+)     # value
                                                $/x ) {
            my ( $key, $value ) = ( $1, $2 );
            $key =~ s/\s+//g;

            if ( $key eq $infokey ) {
                return $value;
            }
        }
    }

    return;
}

sub tag_base {
    my ( $self, $dir ) = @_;

    my $root = $self->get_info( 'RepositoryRoot', $dir );

    my $module = $self->module;

    my $tagbase = join q{/}, $root, 'tags', $module;

    return $tagbase;
}

sub tag_url {
    my ( $self, $tag, $dir ) = @_;

    my $base = $self->tag_base($dir);

    my $tagurl = join q{/}, $base, $tag;

    return $tagurl;
}

sub trunk_url {
    my ( $self, $dir ) = @_;

    my $root = $self->get_info( 'RepositoryRoot', $dir );

    my $module = $self->module;

    my $trunk = join q{/}, $root, 'trunk', $module;

    return $trunk;
}

sub run_infocmd {
    my ( $self, @args ) = @_;

    my @cmd = $self->build_cmd(@args);

    my ( $in, $out, $err );

    my $success = run \@cmd, \$in, \$out, \$err;
    if ( !$success ) {
        die "Error whilst running @cmd: $err\n";
    }

    my @out = split /[\r\n]+/, $out;

    return @out;
}

sub checkcommitted {
    my ( $self, $dir ) = @_;

    warn "Checking that all file changes have been committed.\n";

    if ( !defined $dir ) {
        $dir = $self->workdir;
    }

    my @notcommitted = $self->run_infocmd( 'status', '--quiet', $dir );

    my $allcommitted;
    if ( scalar @notcommitted > 0 ) {
        $allcommitted = 0;
    }
    else {
        $allcommitted = 1;
    }

    if (wantarray) {
        # This makes the output the same as for the CVS module

        my @shortnames;
        for my $file (@notcommitted) {
            if ( $file =~ m/^M\s+(.+)$/ ) {
                my $short = File::Spec->abs2rel( $1, $dir );
                push @shortnames, $short;
            }
        }

        return ( $allcommitted, @shortnames );
    }
    else {
        return $allcommitted;
    }

}

sub checkout_project {
    my ( $self, $version, $outdir ) = @_;

    my $url;
    if ( defined $version ) {
        my $tag = $self->gen_tag($version);
        $url = $self->tag_url($tag);
    }
    else {
        $url = $self->trunk_url();
    }

    my @cmd = ( 'checkout', $url );
    if ( defined $outdir ) {
        push @cmd, $outdir;
    }

    $self->run_cmd(@cmd);

    return;
}

sub export {
    my ( $self, $version, $dir ) = @_;

    my $tag = $self->gen_tag($version);

    my $target = join q{-}, $self->module, $version;
    my $exportdir = File::Spec->catdir( $dir, $target );

    if ( !$self->dryrun ) {
        if ( !-d $dir ) {
            eval { File::Path::mkpath($dir) };
            if ($@) {
                die "Could not create $dir: $@\n";
            }
        }

        if ( -d $exportdir ) {
            File::Path::rmtree($exportdir);
        }
    }

    my $tag_url = $self->tag_url($tag);

    # It appears that svn will pretend that you can export anything
    # whether or not it actually exists. So we have to check for
    # existence first with a 'list' command.

    eval { $self->run_infocmd( 'list', $tag_url ) };
    if ( $@ ) {
        die "Could not find tag $tag_url\n";
    }

    $self->run_cmd( 'export', $tag_url, $exportdir );

    return $exportdir;
}

sub export_devel {
    my ( $self, $version, $dir ) = @_;

    my $target = join q{-}, $self->module, $version;

    my $exportdir = File::Spec->catdir( $dir, $target );

    if ( !$self->dryrun ) {
        if ( !-d $dir ) {
            eval { File::Path::mkpath($dir) };
            if ($@) {
                die "Could not create $dir: $@\n";
            }
        }

        if ( -d $exportdir ) {
            File::Path::rmtree($exportdir);
        }
    }

    $self->run_cmd( 'export', $self->workdir, $exportdir );

    return $exportdir;

}

sub genchangelog {
    my ($self) = @_;

    warn "Generating Changelog from subversion log\n";

    my $trunk = $self->trunk_url();
    my $logfile = $self->logfile;

    if ( !-e $logfile ) {

        # This bit borrowed from File::Touch
        sysopen my $fh, $logfile, O_WRONLY | O_CREAT | O_NONBLOCK | O_NOCTTY
            or die "Cannot create $logfile : $!\n";
        $fh->close or die "Cannot close $logfile : $!\n";

        # Assume it is not already part of the repository
        $self->run_cmd( 'add', $logfile );
    }

    my @cmd = ( '/usr/bin/svn2cl', '--output', $logfile, $trunk );
    if ( $self->dryrun ) {
        print "Dry-run: @cmd\n";
    }
    else {
        my ( $in, $out, $err );
        my $success = run \@cmd, \$in, \$out, \$err;
        if ( !$success ) {
            die "Could not run svn2cl: $err\n";
        }
    }

    return;
}

sub import_project {
    my ( $self, $dir, $version, $message ) = @_;

    if ( !defined $message ) {
        $message = 'Imported with LCFG build tools';
    }

    my $module = $self->module;
    my $trunk_url = $self->trunk_url();

    # we want this to fail...
    eval { $self->run_infocmd( 'list', $trunk_url ) };
    if ( !$@ ) {
        die "There is already a project named \"$module\" at $trunk_url\n";
    }

    $self->run_cmd( 'import',
                    '--message', $message,
                    $dir, $trunk_url );

    my $tag_base = $self->tag_base();

    # Ensure the tags directory for this project actually exists
    eval { $self->run_infocmd( 'list', $tag_base ) };
    if ( $@ ) {
        warn "Creating tag base directory for $module\n";
        $self->run_cmd( 'mkdir', '--message', "Creating tag base directory for $module", $tag_base );
    }

    my $tag = $self->gen_tag($version);

    my $tagurl = $self->tag_url($tag);

    $self->run_cmd( 'copy', '--message', "Tagging $module at $tag", $trunk_url, $tagurl );

    return;
}

sub tagversion {
    my ( $self, $version ) = @_;

    my $module = $self->module;

    warn "Tagging $module at version $version\n";

    $self->update_changelog($version);

    my $dir = $self->workdir;

    $self->run_cmd( 'commit', '--message', "$module release: $version", $dir )
        or die "Could not mark release for $dir at $version\n";

    my $tag_base = $self->tag_base();

    # Ensure the tags directory for this project actually exists
    eval { $self->run_infocmd( 'list', $tag_base ) };
    if ( $@ ) {
        warn "Creating tag base directory for $module\n";
        $self->run_cmd( 'mkdir', '--message', "Creating tag base directory for $module", $tag_base );
    }

    my $tag = $self->gen_tag($version);

    my $tagurl = $self->tag_url($tag);

    $self->run_cmd( 'copy', '--message', "Tagging $module at $tag", $dir, $tagurl );

    $self->run_cmd( 'update', $dir );

    return;
}

__END__