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