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::Tee; 52use strict; 53use base 'SVK::Editor'; 54use List::MoreUtils qw(any); 55 56__PACKAGE__->mk_accessors(qw(editors baton_maps)); 57 58sub new { 59 my $class = shift; 60 my $self = $class->SUPER::new(@_); 61 $self->baton_maps({}); 62 $self->{batons} = 0; 63 return $self; 64} 65 66sub run_editors { # if only we have zip.. 67 my ($self, $baton, $callback) = @_; 68 my $i = 0; 69 my @ret; 70 for (@{$self->editors}) { 71 push @ret, scalar $callback->($_, defined $baton ? $self->baton_maps->{$baton}[$i++] : undef); 72 } 73 return \@ret; 74} 75 76sub AUTOLOAD { 77 my ($self, @arg) = @_; 78 my $func = our $AUTOLOAD; 79 $func =~ s/^.*:://; 80 return if $func =~ m/^[A-Z]+$/; 81 my $baton; 82 my $baton_at = $self->baton_at($func); 83 $baton = $arg[$baton_at] if $baton_at >= 0; 84 85 my $rets = $self->run_editors 86 ( $baton, 87 sub { my ($editor, $baton) = @_; 88 $arg[$baton_at] = $baton if defined $baton; 89 $editor->$func(@arg); 90 }); 91 92 if ($func =~ m/^close_(?:file|directory)/) { 93 delete $self->baton_maps->{$baton}; 94 delete $self->{baton_pools}{$baton}; 95 } 96 97 if ($func =~ m/^(?:add|open)/) { 98 $self->baton_maps->{++$self->{batons}} = $rets; 99 return $self->{batons}; 100 } 101 102 return; 103} 104 105 106sub window_handler { 107 my ($self, $handlers, $window) = @_; 108 for (@$handlers) { 109 next unless $_; 110 SVN::TxDelta::invoke_window_handler($_->[0], $window, $_->[1]); 111 } 112} 113 114#my $pool = SVN::Pool->new; 115sub apply_textdelta { 116 my ($self, $baton, @arg) = @_; 117 my $rets = $self->run_editors($baton, 118 sub { my ($editor, $baton) = @_; 119 unless ($baton) { 120 use Data::Dumper; 121 } 122 $editor->apply_textdelta($baton, @arg); 123 }); 124 125 if (any { defined $_ } @$rets) { 126 my $foo = sub { $self->window_handler($rets, @_) }; 127 my $pool = $self->{baton_pools}{$baton} = SVN::Pool->new; 128 return [SVN::Delta::wrap_window_handler($foo, $pool)]; 129 } 130 131 return; 132} 133 134 1351; 136