File Coverage

blib/lib/SVN/Pusher.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package SVN::Pusher::MirrorEditor;
2              
3 1     1   35654 use strict;
  1         3  
  1         41  
4 1     1   5 use warnings;
  1         2  
  1         30  
5              
6 1     1   25 use 5.008;
  1         15  
  1         46  
7              
8 1     1   509 use SVN::Core;
  0            
  0            
9             use vars qw(@ISA);
10              
11             @ISA = ('SVN::Delta::Editor');
12              
13             use Data::Dumper;
14              
15             use constant VSNURL => 'svn:wc:ra_dav:version-url';
16              
17             sub new {
18             my $class = shift;
19             my $self = $class->SUPER::new(@_);
20             return $self;
21             }
22              
23             sub set_target_revision {
24             return;
25             }
26              
27             sub open_root {
28             my ($self, $remoterev, $pool) =@_;
29             $self->{root} = $self->SUPER::open_root($self->{mirror}{target_headrev}, $pool);
30             }
31              
32             sub open_directory {
33             my ($self,$path,$pb,undef,$pool) = @_;
34             $self->obj->report_file($path, 'M');
35             return $self->SUPER::open_directory ($path, $pb,
36             $self->{mirror}{target_headrev}, $pool);
37             }
38              
39             sub open_file {
40             my ($self,$path,$pb,undef,$pool) = @_;
41             $self->obj->report_file($path, 'M');
42             $self->{opening} = $path;
43             return $self->SUPER::open_file ($path, $pb,
44             $self->{mirror}{target_headrev}, $pool);
45             }
46              
47             sub change_dir_prop {
48             my $self = shift;
49             my $baton = shift;
50             # filter wc specified stuff
51             return unless $baton;
52             return $self->SUPER::change_dir_prop ($baton, @_)
53             unless $_[0] =~ /^svn:(entry|wc):/;
54             }
55              
56             sub change_file_prop {
57             my $self = shift;
58             # filter wc specified stuff
59             return unless $_[0];
60             return $self->SUPER::change_file_prop (@_)
61             unless $_[1] =~ /^svn:(entry|wc):/;
62             }
63              
64             sub add_directory {
65             my $self = shift;
66             my $path = shift;
67             my $pb = shift;
68             my ($cp_path,$cp_rev,$pool) = @_;
69             $self->obj->report_file($path, 'A');
70             $self->SUPER::add_directory($path, $pb, @_);
71             }
72              
73             sub apply_textdelta {
74             my $self = shift;
75             return undef unless $_[0];
76              
77             $self->SUPER::apply_textdelta (@_);
78             }
79              
80             sub close_directory {
81             my $self = shift;
82             my $baton = shift;
83             return unless $baton;
84             $self->{mirror}{VSN} = $self->{NEWVSN}
85             if $baton == $self->{root} && $self->{NEWVSN};
86             $self->SUPER::close_directory ($baton);
87             }
88              
89             sub close_file {
90             my $self = shift;
91             return unless $_[0];
92             $self->SUPER::close_file(@_);
93             }
94              
95             sub add_file {
96             my $self = shift;
97             my $path = shift;
98             my $pb = shift;
99             $self->obj->report_file($path, 'A');
100             $self->SUPER::add_file($path, $pb, @_);
101             }
102              
103             sub delete_entry {
104             my ($self, $path, $rev, $pb, $pool) = @_;
105             $self->obj->report_file($path, 'D');
106             $self->SUPER::delete_entry ($path, $rev, $pb, $pool);
107             }
108              
109             sub obj
110             {
111             my $self = shift;
112              
113             return $self->{mirror};
114             }
115              
116             #sub close_edit {
117             # my ($self) = @_;
118             # return unless $self->{root};
119             # $self->SUPER::close_directory ($self->{root});
120             # $self->SUPER::close_edit (@_);
121             #}
122              
123              
124             package SVN::Pusher::MyCallbacks;
125              
126             use SVN::Ra;
127             our @ISA = ('SVN::Ra::Callbacks');
128              
129             sub get_wc_prop {
130             my ($self, $relpath, $name, $pool) = @_;
131             return undef unless $self->{editor}{opening};
132             return undef unless $name eq 'svn:wc:ra_dav:version-url';
133             return join('/', $self->{mirror}{VSN}, $relpath)
134             if $self->{mirror}{VSN} &&
135             $self->{editor}{opening} eq $relpath; # skip add_file
136              
137             return undef;
138             }
139              
140             # ------------------------------------------------------------------------
141              
142             package SVN::Pusher ;
143              
144             our $VERSION = '0.08';
145             use SVN::Core;
146             use SVN::Repos;
147             use SVN::Fs;
148             use SVN::Delta;
149             use SVN::Ra;
150             use SVN::Client ();
151             use Data::Dumper ;
152             use strict;
153              
154             =head1 NAME
155              
156             SVN::Pusher - Propagate changesets between two different svn repositories.
157              
158             =head1 SYNOPSIS
159              
160             my $m =
161             SVN::Pusher->new(
162             source => $sourceurl,
163             target => $desturl',
164             startrev => 100,
165             endrev => 'HEAD',
166             logmsg => 'push msg'
167             );
168              
169             $m->init();
170              
171             $m->run();
172              
173             =head1 DESCRIPTION
174              
175             See perldoc bin/svn-pusher for more documentation.
176              
177             =cut
178              
179             use File::Spec;
180             use URI::Escape;
181              
182             # ------------------------------------------------------------------------
183              
184             sub report
185             {
186             # Do nothing by default
187             }
188              
189             sub report_msg
190             {
191             my $self = shift;
192             my $msg = shift;
193             return $self->report({'op' => 'msg', 'msg' => $msg });
194             }
195              
196             sub report_file {
197             my ($self, $path, $op) = @_;
198             if ($self->{verbose}) {
199             $self->report({'op' => "file", 'file_op' => $op, 'path' => $path});
200             }
201             }
202              
203             sub committed {
204             my ($self, $date, $sourcerev, $rev, undef, undef, $pool) = @_;
205             my $cpool = SVN::Pool->new_default ($pool);
206              
207             if ($self->{savedate})
208             {
209             $self->{target_update_ra}->change_rev_prop($rev, 'svn:date', $date)
210             }
211             #$self->{rarepos}->change_rev_prop($rev, 'svn:date', $date);
212             #$self->{rarepos}->change_rev_prop($rev, "svm:target_headrev$self->{source}",
213             # "$sourcerev",);
214             #$self->{rarepos}->change_rev_prop($rev, "svm:vsnroot:$self->{source}",
215             # "$self->{VSN}") if $self->{VSN};
216              
217             $self->{target_headrev} = $rev;
218             $self->{target_source_rev} = $sourcerev ;
219             $self->{commit_num}++ ;
220              
221             $self->report_msg("Committed revision $rev from revision $sourcerev.");
222             }
223             # ------------------------------------------------------------------------
224              
225             sub mirror
226             {
227             my ($self, $paths, $rev, $author, $date, $msg, $ppool) = @_;
228              
229              
230             my $pool = SVN::Pool->new_default ($ppool);
231              
232             my $tra = $self->{target_update_ra} ||= SVN::Ra->new(url => $self->{target},
233             auth => $self->{auth},
234             pool => $self->{pool},
235             config => $self->{config},
236             );
237              
238              
239             $msg = $self -> {logmsg} eq '-'?'':$self -> {logmsg} if ($self -> {logmsg}) ;
240             my $def_msg =
241             defined($msg)
242             ? ( $msg . ($self->{verbatim} ? "" : "\n") )
243             : '';
244              
245             my $full_msg = $def_msg
246             . ($self->{verbatim} ? "" : ":$rev:$self->{source_uuid}:$date:");
247              
248             my $editor = SVN::Pusher::MirrorEditor->new
249             ($tra->get_commit_editor(
250             $full_msg
251             ,
252             sub { $self->committed($date, $rev, @_) },
253             undef, 0));
254              
255             $editor->{mirror} = $self;
256              
257              
258             my $sra = $self->{source_update_ra} ||= SVN::Ra->new(url => $self->{source},
259             auth => $self->{auth},
260             pool => $self->{pool},
261             config => $self->{config},
262             );
263              
264             my $reporter =
265             $sra->do_update ($rev+1, '' , 1, $editor);
266              
267             $reporter->set_path ('', $rev,
268             # $self->{target_source_rev}?0:1,
269             0,
270             undef);
271             $reporter->finish_report ();
272             }
273              
274             # ------------------------------------------------------------------------
275              
276             sub new {
277             my $class = shift;
278             my $self = ref $class?bless {@_}, ref $class:bless {@_}, $class;
279              
280             $self->{pool} ||= SVN::Pool->new_default (undef);
281             $self->{config} ||= SVN::Core::config_get_config(undef, $self->{pool});
282             $self->{auth} ||= SVN::Core::auth_open ([SVN::Client::get_simple_provider,
283             SVN::Client::get_ssl_server_trust_file_provider,
284             SVN::Client::get_ssl_client_cert_file_provider,
285             SVN::Client::get_ssl_client_cert_pw_file_provider,
286             SVN::Client::get_username_provider]);
287              
288             return $self;
289             }
290              
291             # ------------------------------------------------------------------------
292              
293             sub do_init
294             {
295             my $self = shift;
296              
297             $self->{source_ra} = SVN::Ra->new(url => $self->{source},
298             auth => $self->{auth},
299             pool => $self->{pool},
300             config => $self->{config},
301             #callback => 'SVN::Pusher::MyCallbacks'
302             );
303             $self->{source_headrev} = $self->{source_ra}->get_latest_revnum;
304             $self->{source_root} = $self -> {source_ra} -> get_repos_root ;
305             $self->{source_path} = substr ($self -> {source}, length ($self->{source_root})) || '/' ;
306             $self->{source_uuid} = $self -> {source_ra}->get_uuid ();
307              
308             $self->report_msg("Source: $self->{source}");
309             $self->report_msg(" Revision: $self->{source_headrev}");
310             $self->report_msg(" Root: $self->{source_root}");
311             $self->report_msg(" Path: $self->{source_path}");
312              
313             $self->{target_ra} = SVN::Ra->new(url => $self->{target},
314             auth => $self->{auth},
315             pool => $self->{pool},
316             config => $self->{config},
317             );
318              
319              
320             $self->{target_headrev} = $self->{target_ra}->get_latest_revnum;
321             $self->{target_root} = $self -> {target_ra} -> get_repos_root ;
322              
323             $self->{target_path} = substr ($self -> {target}, length ($self->{target_root})) ||'/' ;
324              
325             $self->report_msg( "Target: $self->{target}") ;
326             $self->report_msg(" Revision: $self->{target_headrev}") ;
327             $self->report_msg(" Root: $self->{target_root}") ;
328             $self->report_msg(" Path: $self->{target_path}") ;
329              
330             return 1 ;
331             }
332              
333             # ------------------------------------------------------------------------
334              
335             # This method is essentialy do_init(). In the original SVN::Push there were
336             # both init() and do_init() which were different from a reason. Here, they
337             # are essentially the same.
338             sub init
339             {
340             my $self = shift;
341              
342             return $self -> do_init ;
343             }
344              
345             # ------------------------------------------------------------------------
346              
347             sub run {
348             my $self = shift;
349              
350             my $endrev = $self->{endrev} || $self -> {source_headrev} ;
351             if ($self->{endrev} && $self->{endrev} eq 'HEAD')
352             {
353             $endrev = $self->{source_headrev};
354             }
355             if ($endrev > $self -> {source_headrev})
356             {
357             $endrev = $self->{source_headrev};
358             }
359             $self->{endrev} = $endrev ;
360              
361             my $startrev = $self->{startrev} || 0 ;
362             if (defined($self->{target_source_rev}) &&
363             ($self->{target_source_rev} + 1 > $startrev))
364             {
365             $startrev = $self->{target_source_rev} + 1;
366             }
367             $self->{startrev} = $startrev ;
368              
369             return unless $endrev == -1 || $startrev <= $endrev;
370              
371             $self->report_msg("Retrieving log information from $startrev to $endrev");
372              
373             $self -> {source_ra} -> get_log (
374             # paths
375             [''],
376             # start_rev
377             $startrev,
378             # end_rev
379             $endrev-1,
380             # limit
381             0,
382             # discover_changed_paths
383             1,
384             # strict_node_history
385             1,
386             # receiver + receiver_baton
387             sub {
388             my ($paths, $rev, $author, $date, $msg, $pool) = @_;
389              
390             eval {
391             $self->mirror($paths, $rev, $author,
392             $date, $msg, $pool); } ;
393             if ($@)
394             {
395             my $e = $@ ;
396             $e =~ s/ at .+$// ;
397             $self->report_msg($e) ;
398             }
399             });
400             }
401              
402             =head1 BUGS
403              
404             Please report any bugs or feature requests to
405             C, or through the web interface at
406             L.
407             I will be notified, and then you'll automatically be notified of progress on
408             your bug as I make changes.
409              
410             =head1 SUPPORT
411              
412             You can find documentation for this module with the perldoc command.
413              
414             perldoc SVN::Pusher
415              
416             You can also look for information at:
417              
418             =over 4
419              
420             =item * AnnoCPAN: Annotated CPAN documentation
421              
422             L
423              
424             =item * CPAN Ratings
425              
426             L
427              
428             =item * RT: CPAN's request tracker
429              
430             L
431              
432             =item * Search CPAN
433              
434             L
435              
436             =back
437              
438             =head1 SOURCE AVAILABILITY
439              
440             The latest source of SVN::Pusher is available from its
441             BerliOS Subversion repository:
442              
443             L
444              
445             =head1 AUTHORS
446              
447             Shlomi Fish Eshlomif@iglu.org.ilE
448              
449             (based on SVN::Push by Gerald Richter Erichter@dev.ecos.deE)
450              
451             =head1 CREDITS
452              
453             Original SVN::Push module by Gerald Richter. Modified into SVN::Pusher
454             by Shlomi Fish.
455              
456             A lot of ideas and code were taken from the SVN::Mirror module which is by
457             Chia-liang Kao Eclkao@clkao.orgE
458              
459             =head1 COPYRIGHT
460              
461             Copyright 2004 by Gerald Richter Erichter@dev.ecos.deE
462              
463             This program is free software; you can redistribute it and/or modify it
464             under the same terms as Perl itself.
465              
466             See L
467              
468             =cut
469              
470             1;