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::Status; 52use strict; 53use SVN::Delta; 54use SVK::Logger; 55use SVK::Version; our $VERSION = $SVK::VERSION; 56use base 'SVK::Editor'; 57 58__PACKAGE__->mk_accessors(qw(report notify tree ignore_absent)); 59 60sub new { 61 my ($class, @arg) = @_; 62 my $self = $class->SUPER::new (@arg); 63 $self->notify( SVK::Notify->new_with_report 64 (defined $self->report ? $self->report : '') ) unless $self->notify; 65 $self->tree(Data::Hierarchy->new) unless $self->tree; 66 use Data::Dumper; 67 $logger->debug(Dumper($self)); 68 return $self; 69} 70 71sub _tree_get { 72 my $self = shift; 73 my $path = shift; 74 $path = $self->tree->{sep} . $path; 75 return $self->tree->get($path, @_); 76} 77 78sub _tree_store { 79 my $self = shift; 80 my $path = shift; 81 $path = $self->tree->{sep} . $path; 82 return $self->tree->store($path, @_); 83} 84 85sub open_root { 86 my ($self, $baserev) = @_; 87 $self->notify->node_status ('', ''); 88 $self->notify->node_baserev ('', $baserev); 89 return ''; 90} 91 92sub add_or_replace { 93 my ($self, $path) = @_; 94 if ($self->notify->node_status ($path)) { 95 $self->notify->node_status ($path, 'R') 96 if $self->notify->node_status ($path) eq 'D'; 97 } 98 else { 99 $self->notify->node_status ($path, 'A'); 100 } 101 $self->{info}{$path}{added_or_replaced} = 1; 102} 103 104sub add_file { 105 my ($self, $path, $pdir, $from_path, $from_rev) = @_; 106 $self->add_or_replace ($path); 107 $self->notify->hist_status ($path, '+', $from_path, $from_rev) 108 if $from_path; 109 return $path; 110} 111 112sub open_file { 113 my $self = shift; 114 return $self->open_node(@_); 115} 116 117sub apply_textdelta { 118 my ($self, $path) = @_; 119 return undef if $self->notify->node_status ($path) eq 'R'; 120 $self->notify->node_status ($path, 'M') 121 if !$self->notify->node_status ($path) || $self->notify->hist_status ($path); 122 return undef; 123} 124 125sub change_file_prop { 126 my ($self, $path, $name, $value) = @_; 127 $self->notify->prop_status ($path, 'M') 128 unless $self->{info}{$path}{added_or_replaced}; 129} 130 131sub close_file { 132 my ($self, $path) = @_; 133 $self->notify->flush ($path); 134 delete $self->{info}{$path}; 135} 136 137sub absent_file { 138 my ($self, $path) = @_; 139 return if $self->ignore_absent; 140 $self->notify->node_status ($path, '!'); 141 $self->notify->flush ($path); 142} 143 144sub delete_entry { 145 my ($self, $path) = @_; 146 $self->notify->node_status ($path, 'D'); 147 my $info = $self->_tree_get ($path); 148 $self->notify->hist_status ($path, '+', $info->{frompath}, 149 $info->{fromrev}) if $info->{frompath}; 150} 151 152sub add_directory { 153 my ($self, $path, $pdir, $from_path, $from_rev) = @_; 154 $self->add_or_replace ($path); 155 if ($from_path) { 156 $self->notify->hist_status ($path, '+', $from_path, $from_rev); 157 $self->_tree_store ($path, {frompath => $from_path, 158 fromrev => $from_rev}); 159 } 160 $self->notify->flush ($path, 1); 161 return $path; 162} 163 164sub open_directory { 165 my $self = shift; 166 return $self->open_node(@_); 167} 168 169sub change_dir_prop { 170 my ($self, $path, $name, $value) = @_; 171 $self->notify->prop_status ($path, 'M') 172 unless $self->{info}{$path}{added_or_replaced}; 173} 174 175sub close_directory { 176 my ($self, $path) = @_; 177 $self->notify->flush_dir ($path); 178 delete $self->{info}{$path}; 179} 180 181sub open_node { 182 my ($self, $path, $pdir, $baserev, $pool) = @_; 183 $self->notify->node_status ($path, '') 184 unless $self->notify->node_status ($path); 185 $self->notify->node_baserev ($path, $baserev); 186 my $info = $self->_tree_get ($path); 187 $self->notify->hist_status ($path, '+', $info->{frompath}, 188 $info->{fromrev}) if $info->{frompath}; 189 return $path; 190} 191 192sub absent_directory { 193 my ($self, $path) = @_; 194 return if $self->ignore_absent; 195 $self->notify->node_status ($path, '!'); 196 $self->notify->flush ($path); 197} 198 199sub conflict { 200 my ($self, $path, $baton, $type) = @_; 201 # backward compatibility 202 $type = 'node' if !$type || $type eq '1'; 203 $self->notify->$_ ($path, 'C') 204 foreach map $_ ."_status", split /,/, $type; 205} 206 207sub obstruct { 208 my ($self, $path) = @_; 209 $self->notify->node_status ($path, '~'); 210} 211 212sub unknown { 213 my ($self, $path) = @_; 214 $self->notify->node_status ($path, '?'); 215 $self->notify->flush ($path); 216} 217 218sub ignored { 219 my ($self, $path) = @_; 220 $self->notify->node_status ($path, 'I'); 221 $self->notify->flush ($path); 222} 223 224sub unchanged { 225 my ($self, $path, @args) = @_; 226 $self->open_node($path, @args); 227 $self->notify->flush ($path); 228} 229 2301; 231