1#!/usr/bin/perl -w
2use strict;
3use SVK;
4use SVK::XD;
5use SVN::Repos;
6use SVK::Util 'traverse_history';
7use Getopt::Long;
8
9my $revspec;
10
11sub usage {
12        print <<EOUSAGE;
13Usage:  pullyu [-r=revision] repopath mirrorpath
14    Prints out a svn dump file from a complete mirrored svk depot.
15    repopath is the path to your local svk repository, usually ~/.svk/local
16    mirrorpath is the path to the mirror, such as /mirrors/myproject
17
18    Example: ./pullyu ~/.svk/local /mirrors/myproject > myproject-svn-dumpfile
19
20EOUSAGE
21exit;
22}
23
24
25die unless GetOptions ("r|revision=s@" => \$revspec);
26
27use SVN::Dump 0.03;
28
29my $repospath = shift or usage();
30my $path      = shift or usage();
31
32my $repos = SVN::Repos::open($repospath) or die $!;
33my $depot = SVK::Depot->new({ depotname => '', repos => $repos, repospath => $repospath});
34my $t  = SVK::Path->real_new({ depot => $depot, path => $path })
35    ->refresh_revision;
36
37my $r = $revspec ? (bless { revspec => $revspec}, 'SVK::Command')->parse_revlist($t) : [0];
38$r->[1] ||= $t->revision;
39
40my ( $m, $mpath ) = $t->is_mirrored;
41die "only whole repository mirrors are supported.\n" if length($mpath);
42$t->revision($r->[1]);
43$t->normalize;
44
45my @revs;
46
47traverse_history(
48    root     => $t->root,
49    path     => $t->path,
50    cross    => 0,
51    callback => sub {
52        my ( $path, $rev ) = @_;
53	return 0 if $rev < $r->[0];
54        unshift @revs, $rev;
55        1;
56    }
57);
58
59autoflush STDERR 1;
60my $i    = 0;
61my $pool = SVN::Pool->new_default;
62
63my $prefix = substr( $m->path, 1 );
64
65print SVN::Dump::Headers->new(
66            { 'SVN-fs-dump-format-version' => 3 } )->as_string;
67print SVN::Dump::Headers->new({ 'UUID' => $m->source_uuid })->as_string;
68my $prev = $r->[0] ? 0 : undef;
69for my $rev (@revs) {
70    $pool->clear;
71
72    my $rrev = $m->find_remote_rev($rev) or next;
73
74    my $r = $t->mclone( revision => $rev );
75    my $scalar;
76    open my $buf, '+>', \$scalar;
77    SVN::Repos::dump_fs2( $repos, $buf, undef, $rev, $rev, 1, 1, undef,
78        undef );
79    seek $buf, 0, 0;
80    my $dump = SVN::Dump->new( { fh => $buf } );
81    while ( my $record = $dump->next_record() ) {
82        next if $record->type eq 'format' || $record->type eq 'uuid';
83	# padding
84	if (!defined $prev || $prev) {
85	    for my $pad (($prev||0)+1 .. $rrev-1) {
86		print pad_rev($pad)->as_string;
87		++$prev;
88	    }
89	}
90
91        my $translate = sub {
92            my $rec = shift;
93            $rec->set_header('Revision-number' => $rrev)
94                if $rec->get_header('Revision-number');
95
96	    if (my $rev = $rec->get_header('Node-copyfrom-rev')) {
97		$rec->set_header('Node-copyfrom-rev' =>
98				 scalar $m->find_remote_rev( $rev ) );
99	    }
100
101	    if (my $path = $rec->get_header('Node-copyfrom-path')) {
102		$path =~ s{^\Q$prefix\E/?}{} or die "$path untranslatable";
103		$rec->set_header('Node-copyfrom-path' => $path );
104	    }
105
106            if ( my $prop = $rec->get_property_block ) {
107                $prop->delete('svm:headrev');
108            }
109
110            if ( my $path = $rec->get_header('Node-path') ) {
111		$path =~ s{^\Q$prefix\E/?}{}
112                    or die "$path not translatable";
113                $rec->set_header('Node-path' => $path);
114            }
115
116        };
117        $translate->( $record );
118        my $inc = $record->get_included_record;
119        $translate->( $inc ) if $inc;
120
121        print $record->as_string;
122    }
123    $prev = $rrev;
124
125    printf STDERR "%d/%d\r", ++$i, scalar @revs;
126}
127
128sub pad_rev {
129    my $rev = shift;
130    my $pad = SVN::Dump::Record->new;
131    $pad->set_headers_block(SVN::Dump::Headers->new( { 'Revision-number' => $rev }) );
132    return $pad;
133}
134
135