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