PageRenderTime 65ms CodeModel.GetById 23ms RepoModel.GetById 0ms app.codeStats 1ms

/SVK-v2.2.3/lib/SVK/XD.pm

#
Perl | 2019 lines | 1601 code | 302 blank | 116 comment | 321 complexity | 2152cfc619a60a0bef4a36a4deb4b952 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0

Large files files are truncated, but you can click here to view the full file

  1. # BEGIN BPS TAGGED BLOCK {{{
  2. # COPYRIGHT:
  3. #
  4. # This software is Copyright (c) 2003-2008 Best Practical Solutions, LLC
  5. # <clkao@bestpractical.com>
  6. #
  7. # (Except where explicitly superseded by other copyright notices)
  8. #
  9. #
  10. # LICENSE:
  11. #
  12. #
  13. # This program is free software; you can redistribute it and/or
  14. # modify it under the terms of either:
  15. #
  16. # a) Version 2 of the GNU General Public License. You should have
  17. # received a copy of the GNU General Public License along with this
  18. # program. If not, write to the Free Software Foundation, Inc., 51
  19. # Franklin Street, Fifth Floor, Boston, MA 02110-1301 or visit
  20. # their web page on the internet at
  21. # http://www.gnu.org/copyleft/gpl.html.
  22. #
  23. # b) Version 1 of Perl's "Artistic License". You should have received
  24. # a copy of the Artistic License with this package, in the file
  25. # named "ARTISTIC". The license is also available at
  26. # http://opensource.org/licenses/artistic-license.php.
  27. #
  28. # This work is distributed in the hope that it will be useful, but
  29. # WITHOUT ANY WARRANTY; without even the implied warranty of
  30. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  31. # General Public License for more details.
  32. #
  33. # CONTRIBUTION SUBMISSION POLICY:
  34. #
  35. # (The following paragraph is not intended to limit the rights granted
  36. # to you to modify and distribute this software under the terms of the
  37. # GNU General Public License and is only of importance to you if you
  38. # choose to contribute your changes and enhancements to the community
  39. # by submitting them to Best Practical Solutions, LLC.)
  40. #
  41. # By intentionally submitting any modifications, corrections or
  42. # derivatives to this work, or any other work intended for use with SVK,
  43. # to Best Practical Solutions, LLC, you confirm that you are the
  44. # copyright holder for those contributions and you grant Best Practical
  45. # Solutions, LLC a nonexclusive, worldwide, irrevocable, royalty-free,
  46. # perpetual, license to use, copy, create derivative works based on
  47. # those contributions, and sublicense and distribute those contributions
  48. # and any derivatives thereof.
  49. #
  50. # END BPS TAGGED BLOCK }}}
  51. package SVK::XD;
  52. use strict;
  53. use SVK::Version; our $VERSION = $SVK::VERSION;
  54. require SVN::Core;
  55. require SVN::Repos;
  56. require SVN::Fs;
  57. use SVK::I18N;
  58. use SVK::Util qw( get_anchor abs_path abs_path_noexist abs2rel splitdir catdir splitpath $SEP
  59. HAS_SYMLINK is_symlink is_executable mimetype mimetype_is_text
  60. md5_fh get_prompt traverse_history make_path dirname
  61. from_native to_native get_encoder get_depot_anchor );
  62. use Data::Hierarchy 0.30;
  63. use autouse 'File::Find' => qw(find);
  64. use autouse 'File::Path' => qw(rmtree);
  65. use autouse 'YAML::Syck' => qw(LoadFile DumpFile);
  66. use SVK::MirrorCatalog;
  67. use PerlIO::eol 0.10 qw( NATIVE LF );
  68. use PerlIO::via::dynamic;
  69. use PerlIO::via::symlink;
  70. use Class::Autouse qw( Path::Class SVK::Editor::Delay );
  71. use Fcntl qw(:flock);
  72. use SVK::Depot;
  73. use SVK::Config;
  74. use SVK::Logger;
  75. =head1 NAME
  76. SVK::XD - svk depot and checkout handling.
  77. =head1 SYNOPSIS
  78. use SVK::XD;
  79. $xd = SVK::XD->new (depotmap => { '' => '/path/to/repos'});
  80. =head1 TERMINOLOGY
  81. =over
  82. =item depot
  83. A repository referred by a name. The default depot is '' (the empty string).
  84. =item depotpath
  85. A path referred by a depot name and the path inside the depot. For
  86. example, F<//foo/bar> means F</foo/bar> in the default depot '', and
  87. F</test/foo/bar> means F</foo/bar> in the depot B<test>.
  88. =item copath
  89. Checkout path. A path in the file system that has a checked out
  90. version of a certain depotpath.
  91. =back
  92. =head1 CONSTRUCTOR
  93. Options to C<new>:
  94. =over
  95. =item depotmap
  96. A hash reference for depot name and repository path mapping.
  97. =item checkout
  98. A L<Data::Hierarchy> object for checkout paths mapping.
  99. =item giantlock
  100. A filename for global locking. This file protects all read and write
  101. accesses to the C<statefile>.
  102. When SVK begins to execute any command, it attempt to get a write lock
  103. on this "giant lock" file. Once it gets the lock, it writes its PID
  104. to the file, reads in its C<statefile>, and begins to execute the
  105. command. Executing the command consists of a "lock" phase and a "run"
  106. phase. During the lock phase, a command can do one of three things:
  107. request to keep the giant lock for the entire execution (for commands
  108. which modify large parts of the C<statefile>), request to lock
  109. individual checkout paths, or not request a lock.
  110. In the first case, the command sets the C<hold_giant> field on the
  111. L<SVK::Command> object (this should probably change to a real API),
  112. and the command does not release the giant lock until it is finished;
  113. it can rewrite the C<statefile> at the end of its execution without
  114. waiting on the lock, since it already holds it.
  115. In the second case, the command calls C<lock> on the L<SVK::XD> object
  116. one or more times; this places a "lock" entry inside the
  117. L<Data::Hierarchy> object in the statefile next to each locked path,
  118. unless they are already locked by another process. Between its lock
  119. phase and its run phase, the C<statefile> is written to disk (with the
  120. new C<lock> entries) and the giant lock is dropped. After the run
  121. phase, SVK acquires the giant lock again, reads in the C<statefile>,
  122. copies all entries from the paths that it has locked into the version
  123. it just read, clears the lock entries from the hierarchy, writes the
  124. C<statefile> to disk, and drops the giant lock. Any changes to the
  125. hierarchy other than in the locked paths will be ignored.
  126. In the third case, SVK just drops the giant lock after the lock phase
  127. and never tries to read or write the C<statefile> again.
  128. =item statefile
  129. Filename for serializing C<SVK::XD> object.
  130. =item svkpath
  131. Directory name of C<giantlock> and C<statefile>.
  132. =back
  133. =cut
  134. sub new {
  135. my $class = shift;
  136. my $self = bless {}, $class;
  137. %$self = @_;
  138. if ($self->{svkpath}) {
  139. mkdir($self->{svkpath})
  140. or die loc("Cannot create svk-config-directory at '%1': %2\n",
  141. $self->{svkpath}, $!)
  142. unless -d $self->{svkpath};
  143. $self->{signature} ||= SVK::XD::Signature->new (root => $self->cache_directory,
  144. floating => $self->{floating})
  145. }
  146. $self->{checkout} ||= Data::Hierarchy->new( sep => $SEP );
  147. return $self;
  148. }
  149. =head1 METHODS
  150. =head2 Serialization and locking
  151. =over
  152. =item load
  153. Load the serialized C<SVK::XD> data from statefile. Initialize C<$self>
  154. if there's nothing to load. The giant lock is acquired when calling
  155. C<load>.
  156. =cut
  157. sub load {
  158. my ($self) = @_;
  159. my $info;
  160. $self->giant_lock ();
  161. if (-e $self->{statefile}) {
  162. local $@;
  163. $info = eval {LoadFile ($self->{statefile})};
  164. if ($@) {
  165. rename ($self->{statefile}, "$self->{statefile}.backup");
  166. $logger->warn(loc ("Can't load statefile, old statefile saved as %1",
  167. "$self->{statefile}.backup"));
  168. }
  169. elsif ($info) {
  170. $info->{checkout}{sep} = $SEP;
  171. $info->{checkout} = $info->{checkout}->to_absolute($self->{floating})
  172. if $self->{floating};
  173. }
  174. }
  175. $info ||= { depotmap => {'' => catdir($self->{svkpath}, 'local') },
  176. checkout => Data::Hierarchy->new( sep => $SEP ) };
  177. $self->{$_} = $info->{$_} for keys %$info;
  178. $self->{updated} = 0;
  179. $self->create_depots('') if exists $self->{depotmap}{''};
  180. }
  181. =item store
  182. =cut
  183. sub create_depots {
  184. my $self = shift;
  185. my $depotmap = $self->{depotmap};
  186. for my $path (@{$depotmap}{sort (@_ ? @_ : keys %$depotmap)}) {
  187. $path =~ s{[$SEP/]+$}{}go;
  188. next if -d $path;
  189. my $ans = get_prompt(
  190. loc("Repository %1 does not exist, create? (y/n)", $path),
  191. qr/^[yn]/i,
  192. );
  193. next if $ans =~ /^n/i;
  194. $self->_create_depot($path)
  195. }
  196. return;
  197. }
  198. sub _create_depot {
  199. my ($self, $path) = @_;
  200. make_path(dirname($path));
  201. SVN::Repos::create($path, undef, undef, undef,
  202. {'fs-type' => $ENV{SVNFSTYPE} || 'fsfs',
  203. 'bdb-txn-nosync' => '1',
  204. 'bdb-log-autoremove' => '1'});
  205. }
  206. =item store
  207. Serialize C<$self> to the statefile. If giant lock is still ours,
  208. overwrite the file directly. Otherwise load the file again and merge
  209. the paths we locked into the new state file. After C<store> is called,
  210. giant is unlocked.
  211. =cut
  212. sub _store_config {
  213. my ($self, $hash) = @_;
  214. $self->{giantlock_handle} or
  215. die "Internal error: trying to save config without a lock!\n";
  216. local $SIG{INT} = sub { $logger->warn( loc("Please hold on a moment. SVK is writing out a critical configuration file."))};
  217. my $file = $self->{statefile};
  218. my $tmpfile = $file."-$$";
  219. my $oldfile = "$file~";
  220. my $ancient_backup = $file.".bak.".$$;
  221. my $tmphash = { map { $_ => $hash->{$_}} qw/checkout depotmap/ };
  222. $tmphash->{checkout} = $tmphash->{checkout}->to_relative($self->{floating})
  223. if $self->{floating};
  224. DumpFile ($tmpfile, $tmphash);
  225. if (not -f $tmpfile ) {
  226. die loc("Couldn't write your new configuration file to %1. Please try again.", $tmpfile);
  227. }
  228. if (-f $oldfile ) {
  229. rename ( $oldfile => $ancient_backup ) ||
  230. die loc("Couldn't remove your old backup configuration file %1 while writing the new one: %2.\n", $oldfile, $!);
  231. }
  232. if (-f $file ) {
  233. rename ($file => $oldfile) ||
  234. die loc("Couldn't remove your old configuration file %1 while writing the new one: %2.\n", $file, $!);
  235. }
  236. rename ($tmpfile => $file) ||
  237. die loc("Couldn't write your new configuration file %1. A backup has been stored in %2. Please replace %1 with %2 immediately: %3.\n", $file, $tmpfile, $!);
  238. if (-f $ancient_backup ) {
  239. unlink ($ancient_backup) ||
  240. die loc("Couldn't remove your old backup configuration file %1 while writing the new one.", $ancient_backup);
  241. }
  242. }
  243. sub store {
  244. my ($self) = @_;
  245. $self->{updated} = 1;
  246. return unless $self->{statefile};
  247. local $@;
  248. if ($self->{giantlock_handle}) {
  249. # We never gave up the giant lock, so nobody should have written to
  250. # the state file, so we can go ahead and write it out.
  251. $self->_store_config ($self);
  252. }
  253. elsif ($self->{modified}) {
  254. # We don't have the giant lock, but we do have something to
  255. # change, so get the lock, read in the current state, merge in
  256. # the changes from the paths we locked, and write it out.
  257. $self->giant_lock ();
  258. my $info = LoadFile ($self->{statefile});
  259. $info->{checkout} = $info->{checkout}->to_absolute($self->{floating})
  260. if $self->{floating};
  261. my @paths = $info->{checkout}->find ('', {lock => $$});
  262. $info->{checkout}->merge ($self->{checkout}, $_)
  263. for @paths;
  264. $self->_store_config($info);
  265. }
  266. $self->giant_unlock ();
  267. }
  268. =item lock
  269. Lock the given checkout path, store the state with the lock info to
  270. prevent other instances from modifying locked paths.
  271. =cut
  272. sub lock {
  273. my ($self, $path) = @_;
  274. if (my $lock = $self->{checkout}->get ($path, 1)->{lock}) {
  275. my @paths = $self->{checkout}->find('', {lock => $lock});
  276. die loc("%1 already locked at %2, use 'svk cleanup' if lock is stalled\n", $path, $paths[0]);
  277. }
  278. $self->{checkout}->store ($path, {lock => $$});
  279. $self->{modified} = 1;
  280. }
  281. =item unlock
  282. Unlock all the checkout paths that were locked by this instance.
  283. =cut
  284. sub unlock {
  285. my ($self) = @_;
  286. my @paths = $self->{checkout}->find ('', {lock => $$});
  287. $self->{checkout}->store ($_, {lock => undef})
  288. for @paths;
  289. }
  290. =item giant_lock
  291. Lock the statefile globally. All other instances need to wait for the
  292. lock before they can do anything.
  293. =cut
  294. sub giant_lock {
  295. my ($self) = @_;
  296. return unless $self->{giantlock};
  297. my $lock_handle;
  298. my $DIE = sub { my $verb = shift; die "can't $verb giant lock ($self->{giantlock}): $!\n" };
  299. LOCKED: {
  300. for (1..5) {
  301. open($lock_handle, '>>', $self->{giantlock}) or $DIE->('open');
  302. # Try to get an exclusive lock; don't block
  303. my $success = flock $lock_handle, LOCK_EX | LOCK_NB;
  304. last LOCKED if $success;
  305. # Somebody else has it locked; try again in a second.
  306. close($lock_handle);
  307. sleep 1;
  308. }
  309. $self->{updated} = 1;
  310. die loc("Another svk might be running; remove %1 if not.\n", $self->{giantlock});
  311. }
  312. # We've got the lock. For diagnostic purposes, write out our PID.
  313. seek($lock_handle, 0, 0) or $DIE->('rewind');
  314. truncate($lock_handle, 0) or $DIE->('truncate');
  315. $lock_handle->autoflush(1);
  316. (print $lock_handle $$) or $DIE->('write');
  317. $self->{giantlock_handle} = $lock_handle;
  318. }
  319. =item giant_unlock
  320. Release the giant lock.
  321. =back
  322. =cut
  323. sub giant_unlock {
  324. my ($self) = @_;
  325. return unless $self->{giantlock} and $self->{giantlock_handle};
  326. close $self->{giantlock_handle};
  327. unlink ($self->{giantlock});
  328. delete $self->{giantlock_handle};
  329. }
  330. =head2 Depot and path translation
  331. =over
  332. =cut
  333. my %REPOS;
  334. my $REPOSPOOL = SVN::Pool->new;
  335. sub _open_repos {
  336. my ($repospath) = @_;
  337. $REPOS{$repospath} ||= SVN::Repos::open ($repospath, $REPOSPOOL);
  338. }
  339. =item find_repos
  340. Given depotpath and an option about if the repository should be
  341. opened. Returns an array of repository path, the path inside
  342. repository, and the C<SVN::Repos> object if caller wants the
  343. repository to be opened.
  344. =cut
  345. # DEPRECATED
  346. sub find_repos {
  347. my ($self, $depotpath, $open) = @_;
  348. die loc("no depot spec") unless $depotpath;
  349. my ($depot, $path) = $depotpath =~ m|^/([^/]*)(/.*?)/?$|
  350. or die loc("%1 is not a depot path.\n", $depotpath);
  351. $path = Path::Class::foreign_dir('Unix', $path)->stringify;
  352. my $repospath = $self->{depotmap}{$depot} or die loc("No such depot: %1.\n", $depot);
  353. return ($repospath, $path, $open && _open_repos ($repospath));
  354. }
  355. sub find_depotpath {
  356. my ($self, $depotpath) = @_;
  357. die loc("no depot spec") unless $depotpath;
  358. my ($depotname, $path) = $depotpath =~ m|^/([^/]*)(/.*?)/?$|
  359. or die loc("%1 is not a depot path.\n", $depotpath);
  360. $path = Path::Class::foreign_dir('Unix', $path)->stringify;
  361. return ( $self->find_depot($depotname), $path );
  362. }
  363. sub find_depot {
  364. my ($self, $depotname) = @_;
  365. my $repospath = $self->{depotmap}{$depotname} or die loc("No such depot: %1.\n", $depotname);
  366. return SVK::Depot->new( { depotname => $depotname,
  367. repospath => $repospath,
  368. repos => _open_repos($repospath) } );
  369. }
  370. =item find_repos_from_co
  371. Given the checkout path and an option about if the repository should
  372. be opened. Returns an array of repository path, the path inside
  373. repository, the absolute checkout path, the checkout info, and the
  374. C<SVN::Repos> object if caller wants the repository to be opened.
  375. =cut
  376. sub find_repos_from_co {
  377. my ($self, $copath, $open) = @_;
  378. my $report = $copath;
  379. $copath = abs_path (File::Spec->canonpath ($copath));
  380. die loc("path %1 is not a checkout path.\n", $report)
  381. unless $copath;
  382. my ($cinfo, $coroot) = $self->{checkout}->get ($copath);
  383. die loc("path %1 is not a checkout path.\n", $copath) unless %$cinfo;
  384. my ($repospath, $path, $repos) = $self->find_repos ($cinfo->{depotpath}, $open);
  385. return ($repospath, abs2rel ($copath, $coroot => $path, '/'), $copath,
  386. $cinfo, $repos);
  387. }
  388. =item find_repos_from_co_maybe
  389. Like C<find_repos_from_co>, but falls back to see if the given path is
  390. a depotpath. In that case, the checkout paths returned will be undef.
  391. =cut
  392. sub find_repos_from_co_maybe {
  393. my ($self, $target, $open) = @_;
  394. my ($repospath, $path, $copath, $cinfo, $repos);
  395. if (($repospath, $path, $repos) = eval { $self->find_repos ($target, $open) }) {
  396. return ($repospath, $path, undef, undef, $repos);
  397. }
  398. undef $@;
  399. return $self->find_repos_from_co ($target, $open);
  400. }
  401. =item find_depotname
  402. =cut
  403. sub find_depotname {
  404. my ($self, $target, $can_be_co) = @_;
  405. my ($cinfo);
  406. local $@;
  407. if ($can_be_co) {
  408. (undef, undef, $cinfo) = eval { $self->find_repos_from_co ($target, 0) };
  409. $target = $cinfo->{depotpath} unless $@;
  410. }
  411. $self->find_repos ($target, 0);
  412. return ($target =~ m|^/(.*?)/|);
  413. }
  414. =back
  415. =cut
  416. sub target_condensed {
  417. my ($self, @paths) = @_;
  418. return unless @paths;
  419. my $anchor;
  420. for my $path (@paths) {
  421. unless (defined $anchor) {
  422. $anchor = $path->clone;
  423. $anchor->copath_anchor(Path::Class::dir($anchor->copath_anchor));
  424. }
  425. my ($cinfo, $schedule) = $self->get_entry($anchor->copath_anchor, 1);
  426. while ($cinfo->{scheduleanchor} || !-d $anchor->copath_anchor ||
  427. $schedule eq 'add' || $schedule eq 'delete' || $schedule eq 'replace' ||
  428. !( $anchor->copath_anchor->subsumes($path->copath_anchor)) ) {
  429. $anchor->anchorify;
  430. $anchor->copath_anchor(Path::Class::dir($anchor->copath_anchor));
  431. ($cinfo, $schedule) = $self->get_entry($anchor->copath_anchor, 1);
  432. }
  433. push @{$anchor->source->{targets}}, abs2rel($path->copath, $anchor->copath => undef, '/') unless $anchor->path eq $path->path;
  434. }
  435. my $root = $anchor->create_xd_root;
  436. until ($root->check_path($anchor->path_anchor) == $SVN::Node::dir) {
  437. $anchor->anchorify;
  438. }
  439. delete $anchor->{cinfo};
  440. return $anchor;
  441. }
  442. # simliar to command::arg_copath, but still return a target when
  443. # basepath doesn't exist, arg_copath should be gradually deprecated
  444. sub target_from_copath_maybe {
  445. my ($self, $arg) = @_;
  446. my $rev = $arg =~ s/\@(\d+)$// ? $1 : undef;
  447. my ($repospath, $path, $depotpath, $copath, $repos, $view);
  448. unless (($repospath, $path, $repos) = eval { $self->find_repos ($arg, 1) }) {
  449. $arg = File::Spec->canonpath($arg);
  450. $copath = abs_path_noexist($arg);
  451. my ($cinfo, $coroot) = $self->{checkout}->get ($copath);
  452. die loc("path %1 is not a checkout path.\n", $copath) unless %$cinfo;
  453. ($repospath, $path, $repos) = $self->find_repos ($cinfo->{depotpath}, 1);
  454. my ($view_rev, $subpath);
  455. if (($view, $view_rev, $subpath) = $path =~ m{^/\^([\w/\-_]+)(?:\@(\d+)(.*))?$}) {
  456. ($path, $view) = SVK::Command->create_view ($repos, $view, $view_rev, $subpath);
  457. }
  458. $path = abs2rel ($copath, $coroot => $path, '/');
  459. ($depotpath) = $cinfo->{depotpath} =~ m|^/(.*?)/|;
  460. $rev = $cinfo->{revision} unless defined $rev;
  461. $depotpath = "/$depotpath$path";
  462. }
  463. from_native ($path, 'path', $self->{encoding});
  464. undef $@;
  465. my $ret = $self->create_path_object
  466. ( repos => $repos,
  467. repospath => $repospath,
  468. depotpath => $depotpath || $arg,
  469. copath_anchor => $copath,
  470. report => $arg,
  471. path => $path,
  472. view => $view,
  473. revision => $rev,
  474. );
  475. $ret = $ret->as_depotpath unless defined $copath;
  476. return $ret;
  477. }
  478. =head2 create_path_object
  479. Creates and returns a new path object. It can be either L<SVK::Path::Checkout>,
  480. L<SVK::Path::View> or L<SVK::Path>.
  481. Takes a hash with arguments.
  482. If "copath_anchor" argument is defined then L<SVK::Path::Checkout> is created
  483. and other arguments are used to build its L<SVK::Path::Checkout/source>
  484. using this method. If "revision" argument is not defined then the one checkout
  485. path is based on is used.
  486. If "view" argument is defined then L<SVK::Path::View> is created
  487. and other arguments are used to build its L<SVK::Path::Checkout/source> using
  488. this method.
  489. Otherwise L<SVK::Path> is created.
  490. Depot can be passed as L<SVK::Depot> object in "depot" argument or using
  491. "depotname", "repospath" and "repos" arguments. Object takes precendence.
  492. =cut
  493. sub create_path_object {
  494. my ($self, %arg) = @_;
  495. if (my $depotpath = delete $arg{depotpath}) {
  496. ($arg{depotname}) = $depotpath =~ m!^/([^/]*)!;
  497. }
  498. if (defined (my $copath = delete $arg{copath_anchor})) {
  499. require SVK::Path::Checkout;
  500. my $report = delete $arg{report};
  501. $arg{'revision'} = ($self->get_entry( $copath ))[0]->{'revision'}
  502. unless defined $arg{'revision'};
  503. return SVK::Path::Checkout->real_new
  504. ({ xd => $self,
  505. report => $report,
  506. copath_anchor => $copath,
  507. source => $self->create_path_object(%arg) });
  508. }
  509. unless ($arg{depot}) {
  510. my $depotname = delete $arg{depotname};
  511. my $repospath = delete $arg{repospath};
  512. my $repos = delete $arg{repos};
  513. $arg{depot} = SVK::Depot->new({ depotname => $depotname, repos => $repos, repospath => $repospath });
  514. }
  515. my $path;
  516. if (defined (my $view = delete $arg{view})) {
  517. require SVK::Path::View;
  518. $path = SVK::Path::View->real_new
  519. ({ source => $self->create_path_object(%arg),
  520. view => $view,
  521. %arg });
  522. }
  523. else {
  524. $path = SVK::Path->real_new(\%arg);
  525. }
  526. $path->refresh_revision unless defined $path->revision;
  527. return $path;
  528. }
  529. =head2 Checkout handling
  530. =over
  531. =item auto_prop
  532. Return a hash of properties that should attach to the file
  533. automatically when added.
  534. =cut
  535. sub _load_svn_autoprop {
  536. my $self = shift;
  537. $self->{svnautoprop} = {};
  538. local $@;
  539. eval {
  540. SVK::Config->svnconfig->{config}->
  541. enumerate ('auto-props',
  542. sub { $self->{svnautoprop}{compile_apr_fnmatch($_[0])} = $_[1]; 1} );
  543. };
  544. $logger->warn("Your svn is too old, auto-prop in svn config is not supported: $@") if $@;
  545. }
  546. sub auto_prop {
  547. my ($self, $copath) = @_;
  548. # no other prop for links
  549. return {'svn:special' => '*'} if is_symlink($copath);
  550. my $prop;
  551. $prop->{'svn:executable'} = '*' if is_executable($copath);
  552. # auto mime-type: binary or text/* but not text/plain
  553. if ( my $type = mimetype($copath) ) {
  554. $prop->{'svn:mime-type'} = $type
  555. if $type ne 'text/plain'
  556. && ( $type =~ m/^text/ || !mimetype_is_text($type) );
  557. }
  558. # svn auto-prop
  559. if (SVK::Config->svnconfig && SVK::Config->svnconfig->{config}->get_bool ('miscellany', 'enable-auto-props', 0)) {
  560. $self->_load_svn_autoprop unless $self->{svnautoprop};
  561. my (undef, undef, $filename) = splitpath ($copath);
  562. while (my ($pattern, $value) = each %{$self->{svnautoprop}}) {
  563. next unless $filename =~ m/$pattern/;
  564. for (split (/\s*;\s*/, $value)) {
  565. my ($propname, $propvalue) = split (/\s*=\s*/, $_, 2);
  566. $prop->{$propname} = $propvalue;
  567. }
  568. }
  569. }
  570. return $prop;
  571. }
  572. sub do_delete {
  573. my ($self, $target, %arg) = @_;
  574. my (@deleted, @modified, @unknown, @scheduled);
  575. $target->anchorify unless $target->source->{targets};
  576. my @paths = grep {is_symlink($_) || -e $_} $target->copath_targets;
  577. my @to_schedule = @paths;
  578. # check for if the file/dir is modified.
  579. $self->checkout_delta ( $target->for_checkout_delta,
  580. %arg,
  581. xdroot => $target->create_xd_root,
  582. absent_as_delete => 1,
  583. delete_verbose => 1,
  584. absent_verbose => 1,
  585. editor => SVK::Editor::Status->new
  586. ( notify => SVK::Notify->new
  587. ( cb_flush => sub {
  588. my ($path, $status) = @_;
  589. my $copath = $target->copath($path);
  590. $target->contains_copath($copath) or return;
  591. my $st = $status->[0];
  592. if ($st eq 'M') {
  593. push @modified, $copath;
  594. }
  595. elsif ($st eq 'D') {
  596. push @to_schedule, $copath
  597. unless -e $copath;
  598. push @deleted, $copath;
  599. }
  600. else {
  601. push @scheduled, $copath;
  602. }
  603. })),
  604. cb_unknown => sub {
  605. push @unknown, $target->copath($_[1]);
  606. }
  607. );
  608. # use Data::Dumper; warn Dumper \@unknown, \@modified, \@scheduled;
  609. unless ($arg{force_delete}) {
  610. my @reports;
  611. push @reports, sort map { loc("%1 is not under version control", $target->report_copath($_)) } @unknown;
  612. push @reports, sort map { loc("%1 is modified", $target->report_copath($_)) } @modified;
  613. push @reports, sort map { loc("%1 is scheduled", $target->report_copath($_)) } @scheduled;
  614. die join(",\n", @reports) . "; use '--force' to go ahead.\n"
  615. if @reports;
  616. }
  617. # actually remove it from checkout path
  618. my $ignore = $self->ignore;
  619. find(sub {
  620. return if m/$ignore/;
  621. my $cpath = catdir($File::Find::dir, $_);
  622. no warnings 'uninitialized';
  623. return if $self->{checkout}->get($cpath, 1)->{'.schedule'}
  624. eq 'delete';
  625. push @deleted, $cpath;
  626. }, @paths) if @paths;
  627. my %noschedule = map { $_ => 1 } (@unknown, @scheduled);
  628. for (@deleted) {
  629. print "D ".$target->report_copath($_)."\n"
  630. unless $arg{quiet};
  631. }
  632. # don't schedule unknown/added files for deletion as this confuses revert.
  633. for (@to_schedule) {
  634. $self->{checkout}->store ($_, {'.schedule' => 'delete'})
  635. unless $noschedule{$_};
  636. }
  637. if (@scheduled) {
  638. # XXX - should we report something?
  639. require SVK::Command;
  640. $self->{checkout}->store ($_, { SVK::Command->_schedule_empty })
  641. for @scheduled;
  642. }
  643. # TODO: perhaps use the information to warn commiting a rename partially
  644. $self->{checkout}->store($_, {scheduleanchor => $_})
  645. for $target->copath_targets;
  646. return if $arg{no_rm};
  647. rmtree (\@paths) if @paths;
  648. }
  649. sub do_add {
  650. my ($self, $target, %arg) = @_;
  651. $self->checkout_delta(
  652. $target->for_checkout_delta,
  653. %arg,
  654. xdroot => $target->create_xd_root,
  655. editor => SVK::Editor::Status->new(
  656. notify => SVK::Notify->new(
  657. cb_flush => sub {
  658. my ($path, $status) = @_;
  659. to_native($path, 'path');
  660. my $copath = $target->copath($path);
  661. my $report = $target->report ? $target->report->subdir($path) : $path;
  662. $target->contains_copath ($copath) or return;
  663. die loc ("%1 already added.\n", $report)
  664. if !$arg{recursive} && ($status->[0] eq 'R' || $status->[0] eq 'A');
  665. return unless $status->[0] eq 'D';
  666. lstat ($copath);
  667. $self->_do_add('R', $copath, $report, !-d _, %arg)
  668. if -e _;
  669. },
  670. ),
  671. ),
  672. cb_unknown => sub {
  673. my ($editor, $path) = @_;
  674. to_native($path, 'path');
  675. my $copath = $target->copath($path);
  676. my $report = $target->_to_pclass($target->report)->subdir($path);
  677. lstat ($copath);
  678. $self->_do_add('A', $copath, $report, !-d _, %arg);
  679. },
  680. );
  681. return;
  682. }
  683. my %sch = (A => 'add', 'R' => 'replace');
  684. sub _do_add {
  685. my ($self, $st, $copath, $report, $autoprop, %arg) = @_;
  686. my $newprop;
  687. $newprop = $self->auto_prop($copath) if $autoprop;
  688. $self->{checkout}->store($copath, {
  689. '.schedule' => $sch{$st},
  690. $autoprop ? ('.newprop' => $newprop) : ()
  691. });
  692. return if $arg{quiet};
  693. # determine whether the path is binary
  694. my $bin = q{};
  695. if ( ref $newprop && $newprop->{'svn:mime-type'} ) {
  696. $bin = ' - (bin)' if !mimetype_is_text( $newprop->{'svn:mime-type'} );
  697. }
  698. $logger->info( "$st $report$bin");
  699. }
  700. sub do_propset {
  701. my ($self, $target, %arg) = @_;
  702. my ($entry, $schedule) = $self->get_entry($target->copath);
  703. $entry->{'.newprop'} ||= {};
  704. if ( $schedule ne 'add' && !$arg{'adjust_only'} ) {
  705. my $xdroot = $target->create_xd_root;
  706. my ( $source_path, $source_root )
  707. = $self->_copy_source( $entry, $target->copath, $xdroot );
  708. $source_path ||= $target->path_anchor;
  709. $source_root ||= $xdroot;
  710. die loc( "%1 is not under version control.\n", $target->report )
  711. if $xdroot->check_path($source_path) == $SVN::Node::none;
  712. }
  713. #XXX: support working on multiple paths and recursive
  714. die loc("%1 is already scheduled for delete.\n", $target->report)
  715. if $schedule eq 'delete' && !$arg{'adjust_only'};
  716. my %values;
  717. %values = %{$entry->{'.newprop'}} if exists $entry->{'.schedule'};
  718. my $pvalue = defined $arg{propvalue} ? $arg{propvalue} : \undef;
  719. if ( $arg{'adjust_only'} ) {
  720. return unless defined $values{ $arg{propname} };
  721. if ( defined $arg{propvalue} && $values{$arg{propname}} eq $pvalue ) {
  722. delete $values{ $arg{propname} };
  723. }
  724. elsif ( !defined $arg{propvalue} && (!defined $values{$arg{propname}} || (ref $values{$arg{propname}} && !defined $values{$arg{propname}}) )) {
  725. delete $values{ $arg{propname} };
  726. } else {
  727. $values{ $arg{propname} } = $pvalue;
  728. }
  729. } else {
  730. $values{ $arg{propname} } = $pvalue;
  731. }
  732. $self->{checkout}->store ($target->copath,
  733. { '.schedule' => $schedule || 'prop',
  734. '.newprop' => \%values, });
  735. print " M ".$target->report."\n" unless $arg{quiet};
  736. $self->fix_permission($target->copath, $arg{propvalue})
  737. if $arg{propname} eq 'svn:executable';
  738. }
  739. sub fix_permission {
  740. my ($self, $copath, $value) = @_;
  741. my $mode = (stat ($copath))[2];
  742. if (defined $value) {
  743. $mode |= 0111;
  744. }
  745. else {
  746. $mode &= ~0111;
  747. }
  748. chmod ($mode, $copath);
  749. }
  750. =item depot_delta
  751. Generate C<SVN::Delta::Editor> calls to represent the changes between
  752. C<(oldroot, oldpath)> and C<(newroot, newpath)>. oldpath is a array
  753. ref for anchor and target, newpath is just a string.
  754. Options:
  755. =over
  756. =item editor
  757. The editor receiving delta calls.
  758. =item no_textdelta
  759. Don't generate text deltas in C<apply_textdelta> calls.
  760. =item no_recurse
  761. =item notice_ancestry
  762. =back
  763. =cut
  764. sub depot_delta {
  765. my ($self, %arg) = @_;
  766. my @root = map {$_->isa ('SVK::Root') ? $_->root : $_} @arg{qw/oldroot newroot/};
  767. my $editor = $arg{editor};
  768. SVN::Repos::dir_delta ($root[0], @{$arg{oldpath}},
  769. $root[1], $arg{newpath},
  770. $editor, undef,
  771. $arg{no_textdelta} ? 0 : 1,
  772. $arg{no_recurse} ? 0 : 1,
  773. 0, # we never need entry props
  774. $arg{notice_ancestry} ? 0 : 1,
  775. $arg{pool});
  776. }
  777. =item checkout_delta
  778. Generate C<SVN::Delta::Editor> calls to represent the local changes
  779. made to the checked out revision.
  780. Options:
  781. =over
  782. =item delete_verbose
  783. Generate delete_entry calls for sub-entries within deleted entry.
  784. =item absent_verbose
  785. Generate absent_* calls for sub-entries within absent entry.
  786. =item unknown_verbose
  787. generate cb_unknown calls for sub-entries within absent entry.
  788. =item absent_ignore
  789. Don't generate absent_* calls.
  790. =item expand_copy
  791. Mimic the behavior like SVN::Repos::dir_delta, lose copy information
  792. and treat all copied descendents as added too.
  793. =item cb_ignored
  794. Called for ignored items if defined.
  795. =item cb_unchanged
  796. Called for unchanged files if defined.
  797. =back
  798. =cut
  799. # XXX: checkout_delta is getting too complicated and too many options
  800. my %ignore_cache;
  801. sub ignore {
  802. my $self = shift;
  803. my $more_ignores = shift;
  804. no warnings;
  805. my $ignore = SVK::Config->svnconfig ?
  806. SVK::Config->svnconfig->{config}->
  807. get ('miscellany', 'global-ignores', '') : '';
  808. my @ignore = split / /,
  809. ($ignore || "*.o *.lo *.la #*# .*.rej *.rej .*~ *~ .#* .DS_Store");
  810. push @ignore, 'svk-commit*.tmp';
  811. push @ignore, @{$self->{ignore}}
  812. if $self->{ignore};
  813. if (defined $more_ignores) {
  814. push @ignore, split ("\n", $more_ignores);
  815. }
  816. return join('|', map {$ignore_cache{$_} ||= compile_apr_fnmatch($_)} (@ignore));
  817. }
  818. # Emulates APR's apr_fnmatch function with flags=0, which is what
  819. # Subversion uses. Converts a string in fnmatch format to a Perl regexp.
  820. # Code is based on Barrie Slaymaker's Regexp::Shellish.
  821. sub compile_apr_fnmatch {
  822. my $re = shift;
  823. $re =~ s@
  824. ( \\.
  825. | \[ # character class
  826. [!^]? # maybe negation (^ and ! are both supported)
  827. (?: (?:\\.|[^\\\]]) # one item
  828. (?: - # possibly followed by a dash and another
  829. (?:\\.|[^\\\]]))? # item
  830. )* # 0 or more entries (zero case will be checked specially below)
  831. (\]?) # if this ] doesn't match, that means we fell off end of string!
  832. | .
  833. )
  834. @
  835. if ( $1 eq '?' ) {
  836. '.' ;
  837. } elsif ( $1 eq '*' ) {
  838. '.*' ;
  839. } elsif ( substr($1, 0, 1) eq '[') {
  840. if ($1 eq '[]') { # should never match
  841. '[^\s\S]';
  842. } elsif ($1 eq '[!]' or $1 eq '[^]') { # 0-length match
  843. '';
  844. } else {
  845. my $temp = $1;
  846. my $failed = $2 eq '';
  847. if ($failed) {
  848. '[^\s\S]';
  849. } else {
  850. $temp =~ s/(\\.|.)/$1 eq '-' ? '-' : quotemeta(substr($1, -1))/ges;
  851. # the previous step puts in backslashes at beginning and end; remove them
  852. $temp =~ s/^\\\[/[/;
  853. $temp =~ s/\\\]$/]/;
  854. # if it started with [^ or [!, it now starts with [\^ or [\!; fix.
  855. $temp =~ s/^\[ # literal [
  856. \\ # literal backslash
  857. [!^] # literal ! or ^
  858. /[^/x;
  859. $temp;
  860. }
  861. }
  862. } else {
  863. quotemeta(substr( $1, -1 ) ); # ie, either quote it, or if it's \x, quote x
  864. }
  865. @gexs ;
  866. return qr/\A$re\Z/s;
  867. }
  868. # Here be dragon. below is checkout_delta related function.
  869. sub _delta_rev {
  870. my ($self, $arg) = @_;
  871. my $entry = $arg->{cinfo};
  872. my $schedule = $entry->{'.schedule'} || '';
  873. # XXX: uncomment this as mutation coverage test
  874. # return $entry->{revision};
  875. # Lookup the copy source rev for the case of open_directory inside
  876. # add_directotry with history. But shouldn't do so for replaced
  877. # items, because the rev here is used for delete_entry
  878. my ($source_path, $source_rev) = $schedule ne 'replace' ?
  879. $self->_copy_source($entry, $arg->{copath}) : ();
  880. ($source_path, $source_rev) = ($arg->{path}, $entry->{revision})
  881. unless defined $source_path;
  882. return $source_rev;
  883. }
  884. sub _delta_content {
  885. my ($self, %arg) = @_;
  886. my $handle = $arg{editor}->apply_textdelta ($arg{baton}, $arg{md5}, $arg{pool});
  887. return unless $handle && $#{$handle} > 0;
  888. if ($arg{send_delta} && $arg{base}) {
  889. my $spool = SVN::Pool->new_default ($arg{pool});
  890. my $source = $arg{base_root}->file_contents ($arg{base_path}, $spool);
  891. my $txstream = SVN::TxDelta::new
  892. ($source, $arg{fh}, $spool);
  893. SVN::TxDelta::send_txstream ($txstream, @$handle, $spool);
  894. }
  895. else {
  896. SVN::TxDelta::send_stream ($arg{fh}, @$handle, SVN::Pool->new ($arg{pool}))
  897. }
  898. }
  899. sub _unknown_verbose {
  900. my ($self, %arg) = @_;
  901. my $ignore = $self->ignore;
  902. # The caller should have processed the entry already.
  903. my %seen = ($arg{copath} => 1);
  904. my @new_targets;
  905. if ($arg{targets}) {
  906. ENTRY: for my $entry (@{$arg{targets}}) {
  907. my $now = '';
  908. for my $dir (splitdir ($entry)) {
  909. $now .= $now ? "/$dir" : $dir;
  910. my $copath = SVK::Path::Checkout->copath ($arg{copath}, $now);
  911. next if $seen{$copath};
  912. $seen{$copath} = 1;
  913. lstat $copath;
  914. unless (-e _) {
  915. $logger->warn( loc ("Unknown target: %1.", $copath));
  916. next ENTRY;
  917. }
  918. unless (-r _) {
  919. $logger->warn( loc ("Warning: %1 is unreadable.", $copath));
  920. next ENTRY;
  921. }
  922. $arg{cb_unknown}->($arg{editor}, catdir($arg{entry}, $now), $arg{baton});
  923. }
  924. push @new_targets, SVK::Path::Checkout->copath ($arg{copath}, $entry);
  925. }
  926. return unless @new_targets;
  927. }
  928. my $nentry = $arg{entry};
  929. to_native($nentry, 'path', $arg{encoder});
  930. find ({ preprocess => sub { sort @_ },
  931. wanted =>
  932. sub {
  933. $File::Find::prune = 1, return if m/$ignore/;
  934. my $copath = catdir($File::Find::dir, $_);
  935. return if $seen{$copath};
  936. my $schedule = $self->{checkout}->get ($copath)->{'.schedule'} || '';
  937. return if $schedule eq 'delete';
  938. my $dpath = abs2rel($copath, $arg{copath} => $nentry, '/');
  939. from_native($dpath, 'path');
  940. $arg{cb_unknown}->($arg{editor}, $dpath, $arg{baton});
  941. }}, defined $arg{targets} ? @new_targets : $arg{copath});
  942. }
  943. sub _node_deleted {
  944. my ($self, %arg) = @_;
  945. $arg{rev} = $self->_delta_rev(\%arg);
  946. $arg{editor}->delete_entry (@arg{qw/entry rev baton pool/});
  947. if ($arg{kind} == $SVN::Node::dir && $arg{delete_verbose}) {
  948. my @paths;
  949. $self->depot_delta( oldroot => $arg{base_root}->fs->revision_root(0),
  950. newroot => $arg{base_root},
  951. oldpath => ['/', ''],
  952. newpath => $arg{path},
  953. no_textdela => 1,
  954. editor => SVK::Editor::Status->new
  955. ( notify => SVK::Notify->new
  956. ( cb_flush => sub {
  957. my ($path, $status) = @_;
  958. push @paths, $path
  959. if $status->[0] eq 'A';
  960. }))
  961. );
  962. $arg{editor}->delete_entry("$arg{entry}/$_", @arg{qw/rev baton pool/})
  963. for sort @paths;
  964. }
  965. }
  966. sub _node_deleted_or_absent {
  967. my ($self, %arg) = @_;
  968. my $schedule = $arg{cinfo}{'.schedule'} || '';
  969. if ($schedule eq 'delete' || $schedule eq 'replace') {
  970. my $should_do_delete = (!$arg{_really_in_copy} && !$arg{base})
  971. || $arg{copath} eq ($arg{cinfo}{scheduleanchor} || '');
  972. $self->_node_deleted (%arg)
  973. if $should_do_delete;
  974. # when doing add over deleted entry, descend into it
  975. if ($schedule eq 'delete') {
  976. $self->_unknown_verbose (%arg)
  977. if $arg{cb_unknown} && $arg{unknown_verbose};
  978. return $should_do_delete;
  979. }
  980. }
  981. if ($arg{type}) {
  982. if ($arg{kind} && !$schedule &&
  983. (($arg{type} eq 'file') xor ($arg{kind} == $SVN::Node::file))) {
  984. if ($arg{obstruct_as_replace}) {
  985. $self->_node_deleted (%arg);
  986. }
  987. else {
  988. $arg{cb_obstruct}->($arg{editor}, $arg{entry}, $arg{baton})
  989. if $arg{cb_obstruct};
  990. return 1;
  991. }
  992. }
  993. }
  994. else {
  995. # deleted during base_root -> xdroot
  996. if (!$arg{base_root_is_xd} && $arg{kind} == $SVN::Node::none) {
  997. $self->_node_deleted (%arg);
  998. return 1;
  999. }
  1000. return 1 if $arg{absent_ignore};
  1001. # absent
  1002. my $type = $arg{kind} == $SVN::Node::dir ? 'directory' : 'file';
  1003. if ($arg{absent_as_delete}) {
  1004. $arg{rev} = $self->_delta_rev(\%arg);
  1005. $self->_node_deleted (%arg);
  1006. }
  1007. else {
  1008. my $func = "absent_$type";
  1009. $arg{editor}->$func (@arg{qw/entry baton pool/});
  1010. }
  1011. return 1 unless $type ne 'file' && $arg{absent_verbose};
  1012. }
  1013. return 0;
  1014. }
  1015. sub _prop_delta {
  1016. my ($baseprop, $newprop) = @_;
  1017. return $newprop unless $baseprop && keys %$baseprop;
  1018. return { map {$_ => undef} keys %$baseprop } unless $newprop && keys %$newprop;
  1019. my $changed;
  1020. for my $propname (keys %{ { %$baseprop, %$newprop } }) {
  1021. # deref propvalue
  1022. my @value = map { $_ ? ref ($_) ? '' : $_ : '' }
  1023. map {$_->{$propname}} ($baseprop, $newprop);
  1024. $changed->{$propname} = $newprop->{$propname}
  1025. unless $value[0] eq $value[1];
  1026. }
  1027. return $changed;
  1028. }
  1029. sub _prop_changed {
  1030. my ($root1, $path1, $root2, $path2) = @_;
  1031. ($root1, $root2) = map {$_->isa ('SVK::Root') ? $_->root : $_} ($root1, $root2);
  1032. return SVN::Fs::props_changed ($root1, $path1, $root2, $path2);
  1033. }
  1034. sub _node_props {
  1035. my ($self, %arg) = @_;
  1036. my $schedule = $arg{cinfo}{'.schedule'} || '';
  1037. my $props = $arg{kind} ? $schedule eq 'replace' ? {} : $arg{xdroot}->node_proplist ($arg{path}) :
  1038. $arg{base_kind} ? $arg{base_root}->node_proplist ($arg{base_path}) : {};
  1039. my $newprops = (!$schedule && $arg{auto_add} && $arg{kind} == $SVN::Node::none && $arg{type} eq 'file')
  1040. ? $self->auto_prop ($arg{copath}) : $arg{cinfo}{'.newprop'};
  1041. my $fullprop = _combine_prop ($props, $newprops);
  1042. if (!$arg{base} or $arg{in_copy}) {
  1043. $newprops = $fullprop;
  1044. }
  1045. elsif (!$arg{base_root_is_xd} && $arg{base}) {
  1046. $newprops = _prop_delta ($arg{base_root}->node_proplist ($arg{base_path}), $fullprop)
  1047. if $arg{kind} && $arg{base_kind} && _prop_changed (@arg{qw/base_root base_path xdroot path/});
  1048. }
  1049. return ($newprops, $fullprop)
  1050. }
  1051. sub _node_type {
  1052. my $copath = shift;
  1053. my $st = [lstat ($copath)];
  1054. return '' if !-e _;
  1055. unless (-r _) {
  1056. $logger->warn( loc ("Warning: %1 is unreadable.", $copath));
  1057. return;
  1058. }
  1059. return ('file', $st) if -f _ or is_symlink;
  1060. return ('directory', $st) if -d _;
  1061. $logger->warn( loc ("Warning: unsupported node type %1.", $copath));
  1062. return ('', $st);
  1063. }
  1064. use Fcntl ':mode';
  1065. sub _delta_file {
  1066. my ($self, %arg) = @_;
  1067. my $pool = SVN::Pool->new_default (undef);
  1068. my $cinfo = $arg{cinfo} ||= $self->{checkout}->get ($arg{copath});
  1069. my $schedule = $cinfo->{'.schedule'} || '';
  1070. my $modified;
  1071. if ($arg{cb_conflict} && $cinfo->{'.conflict'}) {
  1072. ++$modified;
  1073. $arg{cb_conflict}->($arg{editor}, $arg{entry}, $arg{baton}, $cinfo->{'.conflict'});
  1074. }
  1075. return 1 if $self->_node_deleted_or_absent (%arg, pool => $pool);
  1076. my ($newprops, $fullprops) = $self->_node_props (%arg);
  1077. if (HAS_SYMLINK && (defined $fullprops->{'svn:special'} xor S_ISLNK($arg{st}[2]))) {
  1078. # special case obstructure for links, since it's not standard
  1079. return 1 if $self->_node_deleted_or_absent (%arg,
  1080. type => 'link',
  1081. pool => $pool);
  1082. if ($arg{obstruct_as_replace}) {
  1083. $schedule = 'replace';
  1084. $fullprops = $newprops = $self->auto_prop($arg{copath}) || {};
  1085. }
  1086. else {
  1087. return 1;
  1088. }
  1089. }
  1090. $arg{add} = 1 if $arg{auto_add} && $arg{base_kind} == $SVN::Node::none ||
  1091. $schedule eq 'replace';
  1092. my $fh = get_fh ($arg{xdroot}, '<', $arg{path}, $arg{copath}, $fullprops);
  1093. my $mymd5 = md5_fh ($fh);
  1094. my ($baton, $md5);
  1095. $arg{base} = 0 if $arg{in_copy} || $schedule eq 'replace';
  1096. unless ($schedule || $arg{add} ||
  1097. ($arg{base} && $mymd5 ne ($md5 = $arg{base_root}->file_md5_checksum ($arg{base_path})))) {
  1098. $arg{cb_unchanged}->($arg{editor}, $arg{entry}, $arg{baton},
  1099. $self->_delta_rev(\%arg)
  1100. ) if ($arg{cb_unchanged} && !$modified);
  1101. return $modified;
  1102. }
  1103. $baton = $arg{editor}->add_file ($arg{entry}, $arg{baton},
  1104. $cinfo->{'.copyfrom'} ?
  1105. ($arg{cb_copyfrom}->(@{$cinfo}{qw/.copyfrom .copyfrom_rev/}))
  1106. : (undef, -1), $pool)
  1107. if $arg{add};
  1108. $baton ||= $arg{editor}->open_file ($arg{entry}, $arg{baton}, $self->_delta_rev(\%arg), $pool)
  1109. if keys %$newprops;
  1110. $arg{editor}->change_file_prop ($baton, $_, ref ($newprops->{$_}) ? undef : $newprops->{$_}, $pool)
  1111. for sort keys %$newprops;
  1112. if (!$arg{base} ||
  1113. $mymd5 ne ($md5 ||= $arg{base_root}->file_md5_checksum ($arg{base_path}))) {
  1114. seek $fh, 0, 0;
  1115. $baton ||= $arg{editor}->open_file ($arg{entry}, $arg{baton}, $self->_delta_rev(\%arg), $pool);
  1116. $self->_delta_content (%arg, baton => $baton, pool => $pool,
  1117. fh => $fh, md5 => $arg{base} ? $md5 : undef);
  1118. }
  1119. $arg{editor}->close_file ($baton, $mymd5, $pool) if $baton;
  1120. return 1;
  1121. }
  1122. sub _delta_dir {
  1123. my ($self, %arg) = @_;
  1124. if ($arg{entry} && $arg{exclude} && exists $arg{exclude}{$arg{entry}}) {
  1125. $arg{cb_exclude}->($arg{path}, $arg{copath}) if $arg{cb_exclude};
  1126. return;
  1127. }
  1128. my $pool = SVN::Pool->new_default (undef);
  1129. my $cinfo = $arg{cinfo} ||= $self->{checkout}->get ($arg{copath});
  1130. my $schedule = $cinfo->{'.schedule'} || '';
  1131. $arg{add} = 1 if $arg{auto_add} && $arg{base_kind} == $SVN::Node::none ||
  1132. $schedule eq 'replace';
  1133. # compute targets for children
  1134. my $targets;
  1135. for (@{$arg{targets} || []}) {
  1136. my ($volume, $directories, $file) = splitpath ($_);
  1137. if ( my @dirs = splitdir($directories) ) {
  1138. my $path = $volume . shift(@dirs);
  1139. $file = catdir(grep length, @dirs, $file);
  1140. push @{$targets->{$path}}, $file
  1141. }
  1142. else {
  1143. $targets->{$file} = undef;
  1144. }
  1145. }
  1146. my $thisdir;
  1147. if ($targets) {
  1148. if (exists $targets->{''}) {
  1149. delete $targets->{''};
  1150. $thisdir = 1;
  1151. }
  1152. }
  1153. else {
  1154. $thisdir = 1;
  1155. }
  1156. # don't use depth when we are still traversing through targets
  1157. my $descend = defined $targets || !(defined $arg{depth} && $arg{depth} == 0);
  1158. # XXX: the top level entry is undefined, which should be fixed.
  1159. $arg{cb_conflict}->($arg{editor}, defined $arg{entry} ? $arg{entry} : '', $arg{baton}, $cinfo->{'.conflict'})
  1160. if $thisdir && $arg{cb_conflict} && $cinfo->{'.conflict'};
  1161. return 1 if $self->_node_deleted_or_absent (%arg, pool => $pool);
  1162. # if a node is replaced, it has no base, unless it was replaced with history.
  1163. $arg{base} = 0 if $schedule eq 'replace' && !$cinfo->{'.copyfrom'};
  1164. my ($entries, $baton) = ({});
  1165. if ($arg{add}) {
  1166. $baton = $arg{root} ? $arg{baton} :
  1167. $arg{editor}->add_directory ($arg{entry}, $arg{baton},
  1168. $cinfo->{'.copyfrom'} ?
  1169. ($arg{cb_copyfrom}->(@{$cinfo}{qw/.copyfrom .copyfrom_rev/}))
  1170. : (undef, -1), $pool);
  1171. }
  1172. $entries = $arg{base_root}->dir_entries ($arg{base_path})
  1173. if $arg{base} && $arg{base_kind} == $SVN::Node::dir;
  1174. $baton ||= $arg{root} ? $arg{baton}
  1175. : $arg{editor}->open_directory ($arg{entry}, $arg{baton},
  1176. $self->_delta_rev(\%arg), $pool);
  1177. # check scheduled addition
  1178. # XXX: does this work with copied directory?
  1179. my ($newprops, $fullprops) = $self->_node_props (%arg);
  1180. if ($descend) {
  1181. my $signature;
  1182. if ($self->{signature} && $arg{base_root_is_xd}) {
  1183. $signature = $self->{signature}->load ($arg{copath});
  1184. # if we are not iterating over all entries, keep the old signatures
  1185. $signature->{keepold} = 1 if defined $targets
  1186. }
  1187. # XXX: Merge this with @direntries so we have single entry to descendents
  1188. for my $entry (sort keys %$entries) {
  1189. my $newtarget;
  1190. my $copath = $entry;
  1191. if (defined $targets) {
  1192. next unless exists $targets->{$copath};
  1193. $newtarget = delete $targets->{$copath};
  1194. }
  1195. to_native ($copath, 'path', $arg{encoder});
  1196. my $kind = $entries->{$entry}->kind;
  1197. my $unchanged = ($kind == $SVN::Node::file && $signature && !$signature->changed ($entry));
  1198. $copath = SVK::Path::Checkout->copath ($arg{copath}, $copath);
  1199. my ($ccinfo, $ccschedule) = $self->get_entry($copath, 1);
  1200. # a replace with history node requires handling the copy anchor in the
  1201. # latter direntries loop. we should really merge the two.
  1202. if ($ccschedule eq 'replace') {# && $ccinfo->{'.copyfrom'}) {
  1203. # if ($ccschedule eq 'replace' && $ccinfo->{'.copyfrom'}) {
  1204. delete $entries->{$entry};
  1205. $targets->{$entry} = $newtarget if defined $targets;
  1206. next;
  1207. }
  1208. my $newentry = defined $arg{entry} ? "$arg{entry}/$entry" : $entry;
  1209. my $newpath = $arg{path} eq '/' ? "/$entry" : "$arg{path}/$entry";
  1210. if ($unchanged && !$ccschedule && !$ccinfo->{'.conflict'}) {
  1211. $arg{cb_unchanged}->($arg{editor}, $newentry, $baton,
  1212. $self->_delta_rev({ %arg,
  1213. cinfo => $ccinfo,
  1214. path => $newpath,
  1215. copath => $copath })
  1216. ) if $arg{cb_unchanged};
  1217. next;
  1218. }
  1219. my ($type, $st) = _node_type ($copath);
  1220. next unless defined $type;
  1221. my $delta = $type ? $type eq 'directory' ? \&_delta_dir : \&_delta_file
  1222. : $kind == $SVN::Node::file ? \&_delta_file : \&_delta_dir;
  1223. my $obs = $type ? ($kind == $SVN::Node::dir xor $type eq 'directory') : 0;
  1224. # if the sub-delta returns 1 it means the node is modified. invlidate
  1225. # the signature cache
  1226. $self->$delta ( %arg,
  1227. add => $arg{in_copy} || ($obs && $arg{obstruct_as_replace}),
  1228. type => $type,
  1229. # if copath exist, we have base only if they are of the same type
  1230. base => !$obs,
  1231. depth => defined $arg{depth} ? defined $targets ? $arg{depth} : $arg{depth} - 1: undef,
  1232. entry => $newentry,
  1233. kind => $arg{base_root_is_xd} ? $kind : $arg{xdroot}->check_path ($newpath),
  1234. base_kind => $kind,
  1235. targets => $newtarget,
  1236. baton => $baton,
  1237. root => 0,
  1238. st => $st,
  1239. cinfo => $ccinfo,
  1240. base_path => $arg{base_path} eq '/' ? "/$entry" : "$arg{base_path}/$entry",
  1241. path => $newpath,
  1242. copath => $copath)
  1243. and ($signature && $signature->invalidate ($entry));
  1244. }
  1245. if ($signature) {
  1246. $signature->flush;
  1247. undef $signature;
  1248. }
  1249. my $ignore = $self->ignore ($fullprops->{'svn:ignore'});
  1250. my @direntries;
  1251. # if we are at somewhere arg{copath} not exist, $arg{type} is empty
  1252. if ($arg{type} && !(defined $targets && !keys %$targets)) {
  1253. opendir my ($dir), $arg{copath} or Carp::confess "$arg{copath}: $!";
  1254. for (readdir($dir)) {
  1255. # Completely deny the existance of .svk; we shouldn't
  1256. # show this even with e.g. --no-ignore.
  1257. next if $_ eq '.svk' and $self->{floating};
  1258. if (eval {from_native($_, 'path', $arg{encoder}); 1}) {
  1259. push @direntries, $_;
  1260. }
  1261. elsif ($arg{auto_add}) { # fatal for auto_add
  1262. die "$_: $@";
  1263. }
  1264. else {
  1265. print "$_: $@";
  1266. }
  1267. }
  1268. @direntries = sort grep { !m/^\.+$/ && !exists $entries->{$_} } @direntries;
  1269. }
  1270. for my $copath (@direntries) {
  1271. my $entry = $copath;
  1272. my $newtarget;
  1273. if (defined $targets) {
  1274. next unless exists $targets->{$copath};
  1275. $newtarget = delete $targets->{$copath};
  1276. }
  1277. to_native ($copath, 'path', $arg{encoder});
  1278. my %newpaths = ( copath => SVK::Path::Checkout->copath ($arg{copath}, $copath),
  1279. entry => defined $arg{entry} ? "$arg{entry}/$entry" : $entry,
  1280. path => $arg{path} eq '/' ? "/$entry" : "$arg{path}/$entry",
  1281. base_path => $arg{base_path} eq '/' ? "/$entry" : "$arg{base_path}/$entry",
  1282. targets => $newtarget, base_kind => $SVN::Node::none);
  1283. $newpaths{kind} = $arg{base_root_is_xd} ? $SVN::Node::none :
  1284. $arg{xdroot}->check_path ($newpaths{path}) != $SVN::Node::none;
  1285. my ($ccinfo, $sche) = $self->get_entry($newpaths{copath}, 1);
  1286. my $add = $sche || $arg{auto_add} || $newpaths{kind};
  1287. # If we are not at intermediate path, process ignore
  1288. # for unknowns, as well as the case of auto_add (import)
  1289. if (!defined $targets) {
  1290. if ((!$add || $arg{auto_add}

Large files files are truncated, but you can click here to view the full file