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 }}}
51package SVK::Editor::Checkout;
52use strict;
53our $VERSION = $SVK::VERSION;
54use base 'SVK::Editor';
55use SVK::I18N;
56use SVN::Delta;
57use File::Path;
58use SVK::Util qw( get_anchor md5_fh catpath );
59use IO::Digest;
60
61=head1 NAME
62
63SVK::Editor::File - An editor for modifying files on filesystems
64
65=head1 SYNOPSIS
66
67$editor = SVK::Editor::Checkout->new
68    ( path => $path,
69      get_copath => sub { ... },
70    );
71
72
73=head1 DESCRIPTION
74
75SVK::Editor::Checkout modifies existing checkouts at the paths
76translated by the get_copath callback, according to the incoming
77editor calls.
78
79=head1 PARAMETERS
80
81=over
82
83=item path
84
85The anchor of the editor calls.
86
87=item get_copath
88
89A callback to translate paths in editor calls to copath.
90
91=item ignore_checksum
92
93Don't do checksum verification.
94
95=back
96
97=cut
98
99sub set_target_revision {
100    my ($self, $revision) = @_;
101    $self->{revision} = $revision;
102}
103
104sub open_root {
105    my ($self, $base_revision) = @_;
106    return $self->open_directory ('', '');
107}
108
109sub add_file {
110    my ($self, $path, $pdir) = @_;
111    return unless defined $pdir;
112    my $copath = $path;
113    $self->{added}{$path} = 1;
114    $self->{get_copath}($copath);
115    die loc("path %1 already exists", $path)
116	if !$self->{added}{$pdir} && (-l $copath || -e _);
117    return $path;
118}
119
120sub open_file {
121    my ($self, $path, $pdir) = @_;
122    return unless defined $pdir;
123    my $copath = $path;
124    $self->{get_copath}($copath);
125    die loc("path %1 does not exist", $path) unless -l $copath || -e _;
126    return $path;
127}
128
129sub get_fh {
130    my ($self, $path, $copath) = @_;
131    open my $fh, '>:raw', $copath or warn "can't open $path: $!", return;
132    $self->{iod}{$path} = IO::Digest->new ($fh, 'MD5')
133	unless $self->{ignore_checksum};
134    return $fh;
135}
136
137sub get_base {
138    my ($self, $path, $copath, $checksum) = @_;
139    return unless defined $path;
140    my ($dir,$file) = get_anchor (1, $copath);
141    my $basename = catpath (undef, $dir, ".svk.$file.base");
142    rename ($copath, $basename)
143	or die loc("rename %1 to %2 failed: %3", $copath, $basename, $!);
144
145    open my $base, '<', $basename or die $!;
146    if (!$self->{ignore_checksum} && $checksum) {
147	my $md5 = md5_fh ($base);
148	if ($md5 ne $checksum) {
149	    close $base;
150	    rename $basename, $copath;
151	    return $self->{cb_base_checksum}->($path)
152		if $self->{cb_base_checksum};
153	    die loc("source checksum mismatch")
154	}
155	seek $base, 0, 0;
156    }
157
158    return [$base, $basename, -l $basename ? () : [stat($base)]];
159}
160
161sub close_base {
162    my ($self, $base) = @_;
163    close $base->[0];
164    unlink $base->[1];
165}
166
167sub apply_textdelta {
168    my ($self, $path, $checksum, $pool) = @_;
169    return unless defined $path;
170    return if $self->{check_only};
171    my ($copath, $dpath) = ($path, $path);
172    $self->{get_copath}($copath);
173    my $base;
174    unless ($self->{added}{$path}) {
175	$self->{base}{$path} = $self->get_base ($path, $copath, $checksum)
176	    or return undef;
177	$base = $self->{base}{$path}[0];
178    }
179
180    my $fh = $self->get_fh ($path, $copath) or return undef;
181
182    # The fh is refed by the current default pool, not the pool here
183    return [SVN::TxDelta::apply ($base || SVN::Core::stream_empty($pool),
184				 $fh, undef, undef, $pool)];
185}
186
187sub close_file {
188    my ($self, $path, $checksum) = @_;
189    my $copath = $path;
190    $self->{get_copath}($copath);
191    die loc("result checksum mismatch for %1 (%2 vs %3)", $path, $self->{iod}{$path}->hexdigest, $checksum)
192	if $self->{iod}{$path} && $self->{iod}{$path}->hexdigest ne $checksum;
193
194    if ((my $base = $self->{base}{$path})) {
195	chmod $base->[2][2], $copath if $base->[2];
196	$self->close_base ($base);
197	delete $self->{base}{$path};
198    }
199    delete $self->{iod}{$path};
200    delete $self->{added}{$path};
201}
202
203sub add_directory {
204    my ($self, $path, $pdir) = @_;
205    return unless defined $pdir;
206    my $copath = $path;
207    $self->{get_copath}($copath);
208    die loc("path %1 already exists", $copath) if !$self->{added}{$pdir} && -e $copath;
209    mkdir ($copath) or return undef
210	unless $self->{check_only};
211    $self->{added}{$path} = 1;
212    return $path;
213}
214
215sub open_directory {
216    my ($self, $path, $pdir) = @_;
217    return undef unless defined $pdir;
218    # XXX: test if directory exists
219    return $path;
220}
221
222sub do_delete {
223    my ($self, $path, $copath) = @_;
224    -d $copath ? rmtree ([$copath]) : unlink($copath);
225}
226
227sub delete_entry {
228    my ($self, $path, $revision, $pdir) = @_;
229    return unless defined $pdir;
230    return if $self->{check_only};
231    my $copath = $path;
232    $self->{get_copath}($copath);
233    $self->do_delete ($path, $copath);
234}
235
236sub close_directory {
237    my ($self, $path) = @_;
238    return unless defined $path;
239    delete $self->{added}{$path};
240}
241
242sub change_file_prop {
243    my ($self, $path, $name, $value) = @_;
244    # cache props when add
245    $self->{props}{$path}{$name} = $value
246	if $self->{added}{$path};
247    return if $self->{check_only};
248}
249
250sub change_dir_prop {
251    my ($self, @arg) = @_;
252    $self->change_file_prop (@arg);
253}
254
255sub close_edit {
256    my ($self) = @_;
257#    $self->close_directory('');
258}
259
260sub abort_edit {
261    my ($self) = @_;
262    # XXX: check this
263    $self->close_directory('');
264}
265
266
2671;
268