SVN::Pusher - Propagate changesets between two different svn repositories.


SVN-Pusher documentation Contained in the SVN-Pusher distribution.

Index


Code Index:

NAME

Top

SVN::Pusher - Propagate changesets between two different svn repositories.

SYNOPSIS

Top

    my $m = 
        SVN::Pusher->new(
            source => $sourceurl,
            target => $desturl',
            startrev => 100,
            endrev   => 'HEAD',
            logmsg   => 'push msg'
            );

    $m->init();

    $m->run();

DESCRIPTION

Top

See perldoc bin/svn-pusher for more documentation.

BUGS

Top

Please report any bugs or feature requests to bug-test-run-cmdline@rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=SVN-Pusher. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc SVN::Pusher

You can also look for information at:

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/SVN::Pusher

* CPAN Ratings

http://cpanratings.perl.org/d/SVN::Pusher

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=SVN::Pusher

* Search CPAN

http://search.cpan.org/dist/SVN::Pusher/

SOURCE AVAILABILITY

Top

The latest source of SVN::Pusher is available from its BerliOS Subversion repository:

http://svn.berlios.de/svnroot/repos/web-cpan/SVN-Pusher/

AUTHORS

Top

Shlomi Fish <shlomif@iglu.org.il>

(based on SVN::Push by Gerald Richter <richter@dev.ecos.de>)

CREDITS

Top

Original SVN::Push module by Gerald Richter. Modified into SVN::Pusher by Shlomi Fish.

A lot of ideas and code were taken from the SVN::Mirror module which is by Chia-liang Kao <clkao@clkao.org>

COPYRIGHT

Top


SVN-Pusher documentation Contained in the SVN-Pusher distribution.
use strict;
use warnings;

use SVN::Core;

package SVN::Pusher::MirrorEditor;

use vars qw(@ISA);

@ISA = ('SVN::Delta::Editor');

use Data::Dumper;

use constant VSNURL => 'svn:wc:ra_dav:version-url';

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    return $self;
}

sub set_target_revision {
    return;
}

sub open_root {
    my ($self, $remoterev, $pool) =@_;
    $self->{root} = $self->SUPER::open_root($self->{mirror}{target_headrev}, $pool);
}

sub open_directory {
    my ($self,$path,$pb,undef,$pool) = @_;
    $self->obj->report_file($path, 'M');
    return $self->SUPER::open_directory ($path, $pb,
                     $self->{mirror}{target_headrev}, $pool);
}

sub open_file {
    my ($self,$path,$pb,undef,$pool) = @_;
    $self->obj->report_file($path, 'M');
    $self->{opening} = $path;
    return $self->SUPER::open_file ($path, $pb,
                    $self->{mirror}{target_headrev}, $pool);
}

sub change_dir_prop {
    my $self = shift;
    my $baton = shift;
    # filter wc specified stuff
    return unless $baton;
    return $self->SUPER::change_dir_prop ($baton, @_)
    unless $_[0] =~ /^svn:(entry|wc):/;
}

sub change_file_prop {
    my $self = shift;
    # filter wc specified stuff
    return unless $_[0];
    return $self->SUPER::change_file_prop (@_)
    unless $_[1] =~ /^svn:(entry|wc):/;
}

sub add_directory {
    my $self = shift;
    my $path = shift;
    my $pb = shift;
    my ($cp_path,$cp_rev,$pool) = @_;
    $self->obj->report_file($path, 'A');
    $self->SUPER::add_directory($path, $pb, @_);
}

sub apply_textdelta {
    my $self = shift;
    return undef unless $_[0];

    $self->SUPER::apply_textdelta (@_);
}

sub close_directory {
    my $self = shift;
    my $baton = shift;
    return unless $baton;
    $self->{mirror}{VSN} = $self->{NEWVSN}
    if $baton == $self->{root} && $self->{NEWVSN};
    $self->SUPER::close_directory ($baton);
}

sub close_file {
    my $self = shift;
    return unless $_[0];
    $self->SUPER::close_file(@_);
}

sub add_file {
    my $self = shift;
    my $path = shift;
    my $pb = shift;
    $self->obj->report_file($path, 'A');
    $self->SUPER::add_file($path, $pb, @_);
}

sub delete_entry {
    my ($self, $path, $rev, $pb, $pool) = @_;
    $self->obj->report_file($path, 'D');
    $self->SUPER::delete_entry ($path, $rev, $pb, $pool);
}

sub obj
{
    my $self = shift;

    return $self->{mirror};
}

#sub close_edit {
#    my ($self) = @_;
#    return unless $self->{root};
#    $self->SUPER::close_directory ($self->{root});
#    $self->SUPER::close_edit (@_);
#}


package SVN::Pusher::MyCallbacks;

use SVN::Ra;
our @ISA = ('SVN::Ra::Callbacks');

sub get_wc_prop {
    my ($self, $relpath, $name, $pool) = @_;
    return undef unless $self->{editor}{opening};
    return undef unless $name eq 'svn:wc:ra_dav:version-url';
    return join('/', $self->{mirror}{VSN}, $relpath)
    if $self->{mirror}{VSN} &&
        $self->{editor}{opening} eq $relpath; # skip add_file

    return undef;
}

# ------------------------------------------------------------------------

package SVN::Pusher ;

our $VERSION = '0.06';
use SVN::Core;
use SVN::Repos;
use SVN::Fs;
use SVN::Delta;
use SVN::Ra;
use SVN::Client ();
use Data::Dumper ;
use strict;

use File::Spec;
use URI::Escape;

# ------------------------------------------------------------------------

sub report
{
    # Do nothing by default
}

sub report_msg
{
    my $self = shift;
    my $msg = shift;
    return $self->report({'op' => 'msg', 'msg' => $msg });
}

sub report_file {
    my ($self, $path, $op) = @_;
    if ($self->{verbose}) {
	$self->report({'op' => "file", 'file_op' => $op, 'path' => $path});
    }
}

sub committed {
    my ($self, $date, $sourcerev, $rev, undef, undef, $pool) = @_;
    my $cpool = SVN::Pool->new_default ($pool);

    if ($self->{savedate})
    {
        $self->{target_update_ra}->change_rev_prop($rev, 'svn:date', $date)
    }
    #$self->{rarepos}->change_rev_prop($rev, 'svn:date', $date);
    #$self->{rarepos}->change_rev_prop($rev, "svm:target_headrev$self->{source}",
    #                 "$sourcerev",);
    #$self->{rarepos}->change_rev_prop($rev, "svm:vsnroot:$self->{source}",
    #                 "$self->{VSN}") if $self->{VSN};

    $self->{target_headrev} = $rev;
    $self->{target_source_rev} = $sourcerev ;
    $self->{commit_num}++ ;

    $self->report_msg("Committed revision $rev from revision $sourcerev.");
}
# ------------------------------------------------------------------------

sub mirror 
    {
    my ($self, $paths, $rev, $author, $date, $msg, $ppool) = @_;


    my $pool = SVN::Pool->new_default ($ppool);

    my $tra = $self->{target_update_ra} ||= SVN::Ra->new(url => $self->{target},
              auth   => $self->{auth},
              pool   => $self->{pool},
              config => $self->{config},
              );


    $msg = $self -> {logmsg} eq '-'?'':$self -> {logmsg} if ($self -> {logmsg}) ;
    my $def_msg = 
        defined($msg) 
            ?  ( $msg . ($self->{verbatim} ? "" : "\n") )
            : '';

    my $full_msg = $def_msg
        . ($self->{verbatim} ? "" : ":$rev:$self->{source_uuid}:$date:");

    my $editor = SVN::Pusher::MirrorEditor->new
    ($tra->get_commit_editor(
        $full_msg
        ,
      sub { $self->committed($date, $rev, @_) },
        undef, 0));

    $editor->{mirror} = $self;

    
    my $sra = $self->{source_update_ra} ||= SVN::Ra->new(url => $self->{source},
              auth   => $self->{auth},
              pool   => $self->{pool},
              config => $self->{config},
              );

    my $reporter =
        $sra->do_update ($rev+1, '' , 1, $editor);
    
    $reporter->set_path ('', $rev, 
        # $self->{target_source_rev}?0:1, 
        0,
        undef);
    $reporter->finish_report ();
    }

# ------------------------------------------------------------------------

sub new {
    my $class = shift;
    my $self = ref $class?bless {@_}, ref $class:bless {@_}, $class;

    $self->{pool}   ||= SVN::Pool->new_default (undef);
    $self->{config} ||= SVN::Core::config_get_config(undef, $self->{pool});
    $self->{auth}   ||= SVN::Core::auth_open ([SVN::Client::get_simple_provider,
                  SVN::Client::get_ssl_server_trust_file_provider,
                  SVN::Client::get_ssl_client_cert_file_provider,
                  SVN::Client::get_ssl_client_cert_pw_file_provider,
                  SVN::Client::get_username_provider]);

    return $self;
}

# ------------------------------------------------------------------------

sub do_init 
    {
    my $self = shift;

    $self->{source_ra} = SVN::Ra->new(url => $self->{source},
              auth   => $self->{auth},
              pool   => $self->{pool},
              config => $self->{config},
              #callback => 'SVN::Pusher::MyCallbacks'
              );
    $self->{source_headrev} = $self->{source_ra}->get_latest_revnum;
    $self->{source_root}    = $self -> {source_ra} -> get_repos_root ;
    $self->{source_path}    = substr ($self -> {source}, length ($self->{source_root})) || '/' ;
    $self->{source_uuid}    = $self -> {source_ra}->get_uuid ();

    $self->report_msg("Source: $self->{source}");
    $self->report_msg("  Revision: $self->{source_headrev}");
    $self->report_msg("  Root:     $self->{source_root}");
    $self->report_msg("  Path:     $self->{source_path}"); 

    $self->{target_ra} = SVN::Ra->new(url => $self->{target},
              auth   => $self->{auth},
              pool   => $self->{pool},
              config => $self->{config},
              );
    
    
    $self->{target_headrev} = $self->{target_ra}->get_latest_revnum;
    $self->{target_root}    = $self -> {target_ra} -> get_repos_root ;
    
    $self->{target_path}    = substr ($self -> {target}, length ($self->{target_root})) ||'/' ;
    
    $self->report_msg( "Target: $self->{target}") ;
    $self->report_msg("  Revision: $self->{target_headrev}") ; 
    $self->report_msg("  Root:     $self->{target_root}") ;
    $self->report_msg("  Path:     $self->{target_path}") ; 
    
    return 1 ;
    }

# ------------------------------------------------------------------------

# This method is essentialy do_init(). In the original SVN::Push there were
# both init() and do_init() which were different from a reason. Here, they
# are essentially the same.
sub init 
{
    my $self = shift;
    
    return $self -> do_init ;
}    

# ------------------------------------------------------------------------

sub run {
    my $self   = shift;

    my $endrev = $self->{endrev} || $self -> {source_headrev} ;
    if ($self->{endrev} && $self->{endrev} eq 'HEAD')
    {
        $endrev = $self->{source_headrev};
    }
    if ($endrev > $self -> {source_headrev})
    {
        $endrev = $self->{source_headrev};
    }
    $self->{endrev} = $endrev ;
    
    my $startrev = $self->{startrev} || 0 ;
    if (defined($self->{target_source_rev}) && 
        ($self->{target_source_rev} + 1 > $startrev))
    {
        $startrev = $self->{target_source_rev} + 1;
    }
    $self->{startrev} = $startrev ;
    
    return unless $endrev == -1 || $startrev <= $endrev;

    $self->report_msg("Retrieving log information from $startrev to $endrev");

    $self -> {source_ra} -> get_log (
        # paths
        [''], 
        # start_rev
        $startrev, 
        # end_rev
        $endrev-1, 
        # limit
        0, 
        # discover_changed_paths
        1,
        # strict_node_history
        1,
        # receiver + receiver_baton
          sub {
              my ($paths, $rev, $author, $date, $msg, $pool) = @_;

              eval {
              $self->mirror($paths, $rev, $author,
                    $date, $msg, $pool); } ;
              if ($@)
                  {
                  my $e = $@ ;
                  $e =~ s/ at .+$// ;
                  $self->report_msg($e) ; 
                  }
          });
}

1;