PageRenderTime 47ms CodeModel.GetById 20ms RepoModel.GetById 1ms app.codeStats 0ms

/SVN-Simple-0.28/lib/SVN/Simple/Edit.pm

#
Perl | 361 lines | 333 code | 28 blank | 0 comment | 6 complexity | b684e6ef93b9c72d3b77e8527abf180a MD5 | raw file
  1. package SVN::Simple::Edit;
  2. @ISA = qw(SVN::Delta::Editor);
  3. $VERSION = '0.28';
  4. use strict;
  5. use SVN::Core;
  6. use SVN::Delta;
  7. =head1 NAME
  8. SVN::Simple::Edit - A simple interface for driving svn delta editors
  9. =head1 SYNOPSIS
  10. my $edit = SVN::Simple::Edit->new
  11. (_editor => [SVN::Repos::get_commit_editor($repos, "file://$repospath",
  12. '/', 'root', 'FOO', \&committed)],
  13. );
  14. $edit->open_root($fs->youngest_rev);
  15. $edit->add_directory ('trunk');
  16. $edit->add_file ('trunk/filea');
  17. $edit->modify_file ("trunk/fileb", "content", $checksum);
  18. $edit->delete_entry ("trunk/filec");
  19. $edit->close_edit ();
  20. ...
  21. $edit->copy_directory ('branches/a, trunk, 0);
  22. =head1 DESCRIPTION
  23. SVN::Simple::Edit wraps the subversion delta editor with a perl
  24. friendly interface and then you could easily drive it for describing
  25. changes to a tree. A common usage is to wrap the commit editor, so
  26. you could make commits to a subversion repository easily.
  27. This also means you can not supply the C<$edit> object as an
  28. delta_editor to other API, and that's why this module is named
  29. B<::Edit> instead of B<::Editor>.
  30. See L<SVN::Simple::Editor> for simple interface implementing a delta editor.
  31. =head1 PARAMETERS
  32. =head2 for constructor
  33. =over
  34. =item _editor
  35. The editor that will receive delta editor calls.
  36. =item missing_handler
  37. Called when parent directory are not opened yet, could be:
  38. =over
  39. =item \&SVN::Simple::Edit::build_missing
  40. Always build parents if you don't open them explicitly.
  41. =item \&SVN::Simple::Edit::open_missing
  42. Always open the parents if you don't create them explicitly.
  43. =item SVN::Simple::Edit::check_missing ([$root])
  44. Check if the path exists on $root. Open it if so, otherwise create it.
  45. =back
  46. =item root
  47. The default root to use by SVN::Simple::Edit::check_missing.
  48. =item base_path
  49. The base path the edit object is created to send delta editor calls.
  50. =item noclose
  51. Do not close files or directories. This might make non-sorted
  52. operations on directories/files work.
  53. =back
  54. =head1 METHODS
  55. Note: Don't expect all editors will work with operations not sorted in
  56. DFS order.
  57. =over
  58. =item open_root ($base_rev)
  59. =item add_directory ($path)
  60. =item open_directory ($path)
  61. =item copy_directory ($path, $from, $fromrev)
  62. =item add_file ($path)
  63. =item open_file ($path)
  64. =item copy_file ($path, $from, $fromrev)
  65. =item delete_entry ($path)
  66. =item change_dir_prop ($path, $propname, $propvalue)
  67. =item change_file_prop ($path, $propname, $propvalue)
  68. =item close_edit ()
  69. =back
  70. =cut
  71. require File::Spec::Unix;
  72. sub splitpath { File::Spec::Unix->splitpath(@_) };
  73. sub canonpath { File::Spec::Unix->canonpath(@_) };
  74. sub build_missing {
  75. my ($self, $path) = @_;
  76. $self->add_directory ($path);
  77. }
  78. sub open_missing {
  79. my ($self, $path) = @_;
  80. $self->open_directory ($path);
  81. }
  82. sub check_missing {
  83. my ($root) = @_;
  84. return sub {
  85. my ($self, $path) = @_;
  86. $root ||= $self->{root};
  87. $root->check_path (($self->{base_path} || '')."/$path") == $SVN::Node::none ?
  88. $self->add_directory ($path) : $self->open_directory($path);
  89. }
  90. }
  91. sub new {
  92. my $class = shift;
  93. my $self = $class->SUPER::new(@_);
  94. $self->{BATON} = {};
  95. $self->{missing_handler} ||= \&build_missing;
  96. return $self;
  97. }
  98. sub set_target_revision {
  99. my ($self, $target_revision) = @_;
  100. $self->SUPER::set_target_revision ($target_revision);
  101. }
  102. sub _rev_from_root {
  103. my ($self, $path) = @_;
  104. $path = "/$path" if $path;
  105. $path ||= '';
  106. return $self->{root}->node_created_rev($self->{base_path}.$path);
  107. }
  108. sub open_root {
  109. my ($self, $base_revision) = @_;
  110. $base_revision ||= $self->_rev_from_root () if $self->{root};
  111. $self->{BASE} = $base_revision;
  112. $self->{BATON}{''} = $self->SUPER::open_root
  113. ($base_revision, ${$self->{pool}});
  114. }
  115. sub find_pbaton {
  116. my ($self, $path, $missing_handler) = @_;
  117. use Carp;
  118. return $self->{BATON}{''} unless $path;
  119. my (undef, $dir, undef) = splitpath($path);
  120. $dir = canonpath ($dir);
  121. return $self->{BATON}{$dir} if exists $self->{BATON}{$dir};
  122. $missing_handler ||= $self->{missing_handler};
  123. die "unable to get baton for directory $dir"
  124. unless $missing_handler;
  125. my $pbaton = &$missing_handler ($self, $dir);
  126. return $pbaton;
  127. }
  128. sub close_other_baton {
  129. my ($self, $path) = @_;
  130. return if $self->{noclose};
  131. my (undef, $dir, undef) = splitpath($path);
  132. $dir = canonpath ($dir);
  133. for (reverse sort grep { !$dir || substr ($_, 0, length ($dir)+1) eq "$dir/"}
  134. keys %{$self->{BATON}}) {
  135. next unless $path;
  136. my $baton = $self->{BATON}{$path};
  137. if ($self->{FILES}{$path}) {
  138. $self->SUPER::close_file ($baton, undef, $self->{pool});
  139. }
  140. else {
  141. $self->SUPER::close_directory ($baton, $self->{pool});
  142. }
  143. delete $self->{FILES}{$path};
  144. delete $self->{BATON}{$path};
  145. }
  146. }
  147. sub open_directory {
  148. my ($self, $path, $pbaton) = @_;
  149. $path =~ s|^/||;
  150. $self->close_other_baton ($path);
  151. $pbaton ||= $self->find_pbaton ($path);
  152. my $base_revision = $self->_rev_from_root ($path) if $self->{root};
  153. $base_revision ||= $self->{BASE};
  154. $self->{BATON}{$path} = $self->SUPER::open_directory ($path, $pbaton,
  155. $base_revision,
  156. $self->{pool});
  157. }
  158. sub add_directory {
  159. my ($self, $path, $pbaton) = @_;
  160. $path =~ s|^/||;
  161. $self->close_other_baton ($path);
  162. $pbaton ||= $self->find_pbaton ($path);
  163. $self->{BATON}{$path} = $self->SUPER::add_directory ($path, $pbaton, undef,
  164. -1, $self->{pool});
  165. }
  166. sub copy_directory {
  167. my ($self, $path, $from, $fromrev, $pbaton) = @_;
  168. $path =~ s|^/||;
  169. $pbaton ||= $self->find_pbaton ($path);
  170. $self->{BATON}{$path} = $self->SUPER::add_directory ($path, $pbaton, $from,
  171. $fromrev,
  172. $self->{pool});
  173. }
  174. sub open_file {
  175. my ($self, $path, $pbaton) = @_;
  176. $path =~ s|^/||;
  177. $self->close_other_baton ($path);
  178. $pbaton ||= $self->find_pbaton ($path);
  179. my $base_revision = $self->_rev_from_root ($path) if $self->{root};
  180. $base_revision ||= $self->{BASE};
  181. $self->{FILES}{$path} = 1;
  182. $self->{BATON}{$path} = $self->SUPER::open_file ($path, $pbaton,
  183. $base_revision,
  184. $self->{pool});
  185. }
  186. sub add_file {
  187. my ($self, $path, $pbaton) = @_;
  188. $path =~ s|^/||;
  189. $self->close_other_baton ($path);
  190. $pbaton ||= $self->find_pbaton ($path);
  191. $self->{FILES}{$path} = 1;
  192. $self->{BATON}{$path} = $self->SUPER::add_file ($path, $pbaton, undef, -1,
  193. $self->{pool});
  194. }
  195. sub copy_file {
  196. my ($self, $path, $from, $fromrev, $pbaton) = @_;
  197. $path =~ s|^/||;
  198. $pbaton ||= $self->find_pbaton ($path);
  199. $self->{BATON}{$path} = $self->SUPER::add_file ($path, $pbaton, $from,
  200. $fromrev, $self->{pool});
  201. }
  202. sub modify_file {
  203. my ($self, $path, $content, $targetchecksum) = @_;
  204. $path =~ s|^/|| unless ref($path);
  205. my $baton = ref($path) ? $path :
  206. ($self->{BATON}{$path} || $self->open_file ($path));
  207. my $ret = $self->apply_textdelta ($baton, undef, $self->{pool});
  208. return unless $ret && $ret->[0];
  209. if (ref($content) && $content->isa ('GLOB')) {
  210. my $md5 = SVN::TxDelta::send_stream ($content,
  211. @$ret,
  212. $self->{pool});
  213. die "checksum mistach ($md5) vs ($targetchecksum)" if $targetchecksum
  214. && $targetchecksum ne $md5;
  215. }
  216. else {
  217. SVN::_Delta::svn_txdelta_send_string ($content, @$ret, $self->{pool});
  218. }
  219. }
  220. sub delete_entry {
  221. my ($self, $path, $pbaton) = @_;
  222. my $base_revision;
  223. $path =~ s|^/||;
  224. $pbaton ||= $self->find_pbaton ($path, \&open_missing);
  225. $base_revision = $self->_rev_from_root ($path) if $self->{root};
  226. $base_revision ||= $self->{BASE};
  227. $self->SUPER::delete_entry ($path, $base_revision, $pbaton, $self->{pool});
  228. }
  229. sub change_file_prop {
  230. my ($self, $path, $key, $value) = @_;
  231. $path =~ s|^/|| unless ref($path);
  232. my $baton = ref($path) ? $path :
  233. ($self->{BATON}{$path} || $self->open_file ($path));
  234. $self->SUPER::change_file_prop ($baton, $key, $value, $self->{pool});
  235. }
  236. sub change_dir_prop {
  237. my ($self, $path, $key, $value) = @_;
  238. $path =~ s|^/|| unless ref($path);
  239. my $baton = ref($path) ? $path :
  240. ($self->{BATON}{$path} || $self->open_directory ($path));
  241. $self->SUPER::change_dir_prop ($baton, $key, $value, $self->{pool});
  242. }
  243. sub close_file {
  244. my ($self, $path, $checksum) = @_;
  245. my $baton = $self->{BATON}{$path} or die "not opened";
  246. delete $self->{BATON}{$path};
  247. $self->SUPER::close_file ($baton, $checksum, $self->{pool});
  248. }
  249. sub close_directory {
  250. my ($self, $path) = @_;
  251. my $baton = $self->{BATON}{$path} or die "not opened";
  252. delete $self->{BATON}{$path};
  253. $self->SUPER::close_directory ($baton, $self->{pool});
  254. }
  255. sub close_edit {
  256. my ($self) = @_;
  257. $self->close_other_baton ('');
  258. $self->SUPER::close_edit ($self->{pool});
  259. }
  260. sub abort_edit {
  261. my ($self) = @_;
  262. $self->SUPER::abort_edit ($self->{pool});
  263. }
  264. =head1 AUTHORS
  265. Chia-liang Kao E<lt>clkao@clkao.orgE<gt>
  266. =head1 COPYRIGHT
  267. Copyright 2003-2004 by Chia-liang Kao E<lt>clkao@clkao.orgE<gt>.
  268. This program is free software; you can redistribute it and/or modify it
  269. under the same terms as Perl itself.
  270. See L<http://www.perl.com/perl/misc/Artistic.html>
  271. =cut
  272. 1;